Нужен способ пройти проверку подлинности к веб-сервисам Exchange

Вы не хотите, чтобы загрузка соединений (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 (*).