Макрос Excel для поиска веб-сайта с данными Excel и извлечения конкретных результатов, а затем зацикливаться на следующем значении

Это абсолютно возможно. Вы получаете то, что я часто нахожу сложнее всего, получая информацию с другой платформы. Чтобы сделать эту работу, я бы немного выделил ее и для простоты использовал 2 листа (Лист1 с вашими известными данными и Лист2 для веб-данных).

Переберите свою таблицу из ~ 8000 предприятий. Мы можем определить это по количеству строк в UsedRange. Мы знаем, что ABN находится в столбце 2 (также известный как B), поэтому мы копируем его в переменную для передачи в функцию. Функция вернет «Тип сущности:» в столбец 3 (С) той же строки.

Sub LoopThroughBusinesses() 
    Dim i As Integer
    Dim ABN As String
    For i = 2 To Sheet1.UsedRange.Rows.Count
        ABN = Sheet1.Cells(i, 2)
        Sheet1.Cells(i, 3) = URL_Get_ABN_Query(ABN)
    Next i
End Sub

Измените подпрограмму, которую вы создали, на функцию, чтобы она возвращала тип сущности, к которому вы стремитесь. Функция сохранит данные в Sheet2, а затем вернет только те данные Entity, которые нам нужны.

Function URL_Get_ABN_Query(strSearch As String) As String   ' Change it from a Sub to a Function that returns the desired string
    ' strSearch = Range("a1") ' This is now passed as a parameter into the Function
    Dim entityRange As Range
    With Sheet2.QueryTables.Add( _
            Connection:="URL;http://www.abr.business.gov.au/SearchByABN.aspx?SearchText=" & strSearch & "&safe=active", _
            Destination:=Sheet2.Range("A1"))   ' Change this destination to Sheet2

        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    ' Find the Range that has "Entity Type:"
    Set entityRange = Sheet2.UsedRange.Find("Entity type:")

    ' Then return the value of the cell to its' right
    URL_Get_ABN_Query = entityRange.Offset(0, 1).Value2

    ' Clear Sheet2 for the next run
    Sheet2.UsedRange.Delete

End Function

Вы не хотите, чтобы загрузка соединений (queryTables) была настроена таким образом. Это будет так медленно, если вообще возможно. При 8000 запросах, при условии, что xmlhttp не заблокирован или ограничен, приведенный ниже метод будет значительно быстрее. Если кажется, что происходит замедление / блокировка, добавляйте небольшое ожидание каждые x запросов.

Если возможно, используйте xmlhttp для сбора данных. Используйте селекторы CSS , чтобы специально нацелить тип объекта. Сохраните значения в массиве и запишите их в конце цикла. Используйте класс для хранения объекта xmlhttp для большей эффективности. Предоставьте вашему классу методы, в том числе методы обработки не найденных (приведенный пример). Добавьте некоторые дополнительные оптимизации, например дано отключение обновления экрана. Предполагается, что ваши поисковые номера в столбце B из B2. Приведенный ниже код также выполняет некоторые базовые проверки того, что в столбце B есть что-то, и обрабатывает случай наличия 1 или более чисел.

Хороший код является модульным, и вы хотите, чтобы функция возвращала что-то и подпрограмму для выполнения действий. Одна подпрограмма / функция не должна выполнять множество задач. Вы хотите легко отлаживать код, который следует принципу единоличной ответственности (или близок к нему).

класс clsHTTP

Option Explicit

Private http As Object  
Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetHTML(ByVal URL As String) As String
    Dim sResponse As String
    With http
        .Open "GET", URL, False
        .send
        GetHTML = StrConv(.responseBody, vbUnicode)
    End With
End Function

Public Function GetEntityType(ByVal html As HTMLDocument) As String
    On Error GoTo errhand:
     GetEntityType = html.querySelector("a[href*='EntityTypeDescription']").innerText
    Exit Function
errhand:
    GetEntityType = "Not Found"
End Function

Стандартный модуль:

Option Explicit 
Public Sub GetInfo()
    Dim http As clsHTTP, sResponse As String, lastRow As Long, groupResults(), i As Long, html As HTMLDocument
    Set html = New HTMLDocument
    Set http = New clsHTTP
    Const BASE_URL As String = "http://www.abr.business.gov.au/ABN/View/"
    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(.rows.Count, "B").End(xlUp).Row
        Select Case lastRow
        Case 1
            Exit Sub
        Case 2
            ReDim arr(1, 1): arr(1, 1) = .Range("B2").Value
        Case Else
            arr = .Range("B2:B" & lastRow).Value
        End Select

        ReDim groupResults(1 To lastRow - 1)

        With http
            For i = LBound(arr, 1) To UBound(arr, 1)
                If Len(BASE_URL & arr(i, 1)) > Len(BASE_URL) Then
                    sResponse = .GetHTML(BASE_URL & arr(i, 1))
                    html.body.innerHTML = sResponse
                    groupResults(i) = .GetEntityType(html)
                    sResponse = vbNullString: html.body.innerHTML = vbNullString
                End If
            Next
        End With
        For i = LBound(groupResults) To UBound(groupResults)
            .Cells(i + 1, "C") = groupResults(i)
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Ссылки (VBE> Инструменты> Ссылки):

1. Библиотека объектов Microsoft HTML

Селекторы CSS:

Я использую факт описание объекта представляет собой гиперссылку (тег a), и его значение содержит строку EntityTypeDescription для использования в качестве цели атрибута css attribute = value с оператором contains (*).