Excel VBA: петельные веб-запросы - PullRequest
0 голосов
/ 13 июля 2011

У меня есть список из 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

1 Ответ

0 голосов
/ 23 декабря 2011

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

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

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

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

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

Вы не выполняете шаг lDataSetLastRow после добавления результата.

...