Excel VBA: петельные веб-запросы

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 после добавления результата.