我已将此代码设置为从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
结束子
答案 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