VBA宏,从给定的范围循环中获取URL并提取XML节点

时间:2019-01-05 20:02:53

标签: excel xml vba

我已将此代码设置为从XML URL获取数据邮政编码(单节点)。但是,实际上在Sheet1 B列中有一个URL列表,我需要遍历这些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

结束子

1 个答案:

答案 0 :(得分:0)

假设您的代码可以正常工作,那么您希望在所有URL上都使用For循环之类的东西。将文档移到循环外,然后将其加载到循环内。我使用数组来存储从工作表中读取的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