Макрос VBA, получить URL из заданного цикла диапазона и извлечь узел XML - PullRequest
0 голосов
/ 05 января 2019

У меня есть этот код, который настроен на получение данных ZIP-кода (одного узла) из XML-URL. Однако на самом деле у меня есть список URL-адресов в Sheet1, столбец B, которые мне нужно перебрать, пока все данные не будут извлечены.

Я не хочу обновлять код каждый раз отдельно для каждого URL. Есть тысячи ... Как бы я мог это сделать?

Вот пример рабочего кода для одного URL:

Sub test1()
Dim xmlDocument As MSXML2.DOMDocument60

Dim URL As String
Dim node As Object
Set xmlDocument = New DOMDocument60


URL = Sheets("Sheet1").Range("b2").Value

'Open XML page
        Set xmlDocument = New MSXML2.DOMDocument60
        xmlDocument.async = False
        xmlDocument.validateOnParse = False

xmlDocument.Load URL



Dim nodeId As IXMLDOMNode
Dim nodeId2 As IXMLDOMNode
Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
If Not nodeId Is Nothing Then
    Sheets("fy2016").Range("e2").Value = nodeId.Text & " " & nodeId2.Text
Else
    Sheets("fy2016").Range("e2").Value = "'ZIP code' was not found."
End If

End Sub

1 Ответ

0 голосов
/ 05 января 2019

Предполагая, что ваш код работает, вы хотите что-то вроде цикла по всем URL-адресам. Переместите ваш документ за пределы цикла и загрузите его внутри цикла. Я использую массив для хранения URL-адресов, прочитанных с листа, для более быстрой обработки. Ваша конструкция не обрабатывала никаких ошибок при разборе, поэтому я закомментировал соответствующие строки.

Не тестировалось.

Option Explicit
Public Sub test1()
    Dim xmlDocument As MSXML2.DOMDocument60, URLs(), i As Long
    Dim node As Object, nodeId As IXMLDOMNode, nodeId2 As IXMLDOMNode
    Set xmlDocument = New DOMDocument60

    URLs = ThisWorkbook.Worksheets("Sheet1").Range("B2:B1000").Value

    Set xmlDocument = New MSXML2.DOMDocument60
    xmlDocument.async = False
    ' xmlDocument.validateOnParse = False

    For i = LBound(URLs, 1) To UBound(URLs, 1)
        xmlDocument.Load URLs(i, 1)
        Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
        Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
        If Not nodeId Is Nothing Then
            ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = nodeId.Text & " " & nodeId2.Text
        Else
            ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = "'ZIP code' was not found."
        End If
        Set nodeId = Nothing: Set nodeId2 = Nothing
    Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...