Excel VBA: Looped Web Queries

Question

У меня есть список из 100 000 URL-адресов, которые мне нужно проанализировать с помощью вызова API. Я отсортировал их в списке из 600 + конкатенированных строк, каждый из которых содержит 200 URL-адресов - готов к анализу.

Я написал код, приведенный ниже, чтобы зациклить процесс, помещает возвращаемую информацию о URL-адресах в последнюю строку столбца C по одному за раз. Тем не менее, мой цикл, кажется, сломан, и я не знаю, почему (слишком долго смотрел на него), но я подозреваю, что это ошибка новобранец. После выполнения первых двух конкатенированных строк (400 URL-адресов он начинает переписывать информацию со строки порядка 200, обрабатывая только первую строку.

Код ниже, и любая помощь будет принята с благодарностью. К сожалению, я не могу поделиться URL, что я пытаюсь разобрать, потому что это система уместности построена моими работодателями и не для общественного пользования.

Sub APIDataProcess() 

    Dim lURLsLastRow As Long 
    Dim lDataSetLastRow As Long 
    Dim rngURLDataSet As Range 
    Dim sURLArray As String 
    Dim lURLArrayCount As Long 
    Dim rngArrayCell As Range 

    lURLsLastRow = Cells(Rows.Count, 1).End(xlUp).Row 
    lDataSetLastRow = Cells(Rows.Count, 3).End(xlUp).Row 

    Set rngURLDataSet = Range("A1:A" & lDataSetLastRow) 

    lURLArrayCount = Range("B1").Value ' placeholder for count increments 
    sURLArray = Range("A" & lsURLArrayCount).Value 


    For Each rngArrayCell In rngURLDataSet 

     If lsURLArrayCount <= lURLsLastRow Then 
      With ActiveSheet.QueryTables.Add(Connection:="URL;http://test.test.org/test.php", Destination:=Range("C" & lDataSetLastRow)) 
       .PostText = "urls=" & sURLArray 
       .RowNumbers = False 
       .FillAdjacentFormulas = False 
       .PreserveFormatting = True 
       .RefreshOnFileOpen = False 
       .BackgroundQuery = False 
       .RefreshStyle = xlOverwriteCells 
       .SavePassword = False 
       .SaveData = True 
       .AdjustColumnWidth = True 
       .RefreshPeriod = 0 
       .WebSelectionType = xlEntirePage 
       .WebFormatting = xlWebFormattingNone 
       .WebPreFormattedTextToColumns = True 
       .WebConsecutiveDelimitersAsOne = True 
       .WebSingleBlockTextImport = False 
       .WebDisableDateRecognition = False 
       .WebDisableRedirections = False 
       .Refresh BackgroundQuery:=False 
      End With 
      lURLArrayCount = lURLArrayCount + 1 
      Range("B1").Value = lURLArrayCount 

      Application.Wait Now + TimeValue("00:01:00") 

     Else 
      Exit Sub 

     End If 

    Next rngArrayCell 

End Sub 

Answer 1

Вы, наверное, решить свои собственные проблемы давно, но так как этот вопрос остается открытым, я будет иметь смысл.

Я предполагаю, что предполагается, что B1 изначально 1 и затем после каждого шага обработанный. Это позволит вам остановить макрос и продолжить работу с того места, где вы были в предыдущем запуске.

Но вы не используете B1 или lURLArrayCount, как это. Диапазон, который вы проверяете, всегда равен A1 до Amax. Вы делаете шаг lURLArrayCount и сохраняете его в B1, но его значение не используется в цикле.

Вы устанавливаете sURLArray вне цикла, но используете его внутри.

Цикл For Each rngArrayCell, но вы никогда не используете rngArrayCell.

После того, как результат был добавлен, вы не выполните команду lDataSetLastRow.