(最初标题为“运行时错误91 - 未设置XML对象变量。一半时间工作?”)
我有一个VB脚本,用于打开XML文档并从中提取一些信息。
Function fnReadXMLByTags(address As String) As String
' Part of of adapted from http://excel-macro.tutorialhorizon.com/vba-excel-read-data-from-xml-file/
Dim mainWorkBook As Workbook
Dim mainWS As Worksheet
Dim addressArray()
Dim addressArrayLen As Integer
Dim tempi As Integer
Dim latitude As Double, longitude As Double
Dim county As String, altAddress As String
'Let's add the addresses to look up into our array:
lastRow = Cells(50000, 1).End(xlUp).Row
If lastRow > 1 Then
addressArray() = Range(Cells(1, 1), Cells(lastRow, 1))
Else
addressArray() = Range(Cells(1, 1), Cells(2, 1))
End If
addressArrayLen = UBound(addressArray) - LBound(addressArray) + 1
Set mainWorkBook = ActiveWorkbook
Set mainWS = Sheets("Sheet1")
mainWS.Range("A:A").Clear
Set oXMLFile = CreateObject("Microsoft.XMLDOM")
Dim startRow As Integer, adrRow As Integer
startRow = Cells(50000, 1).End(xlUp).Row
For k = LBound(addressArray) To UBound(addressArray)
If addressArray(k, 1) = "" Then Exit For
strAddress = addressArray(k, 1) ' URLEncode(Address)
'Assemble the query string
strQuery = "http://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
strQuery = strQuery & "&sensor=false"
Debug.Print strQuery
XMLFileName = strQuery
oXMLFile.async = False
oXMLFile.Load (XMLFileName)
Set latitudenodes = oXMLFile.SelectNodes("/GeocodeResponse/result/geometry/location/lat/text()")
Set LongitudeNodes = oXMLFile.SelectNodes("/GeocodeResponse/result/geometry/location/lng/text()")
Set addressNodes = oXMLFile.SelectNodes("/GeocodeResponse/result/formatted_address/text()")
Set countyNodes = oXMLFile.SelectNodes("/GeocodeResponse/result/address_component[type='administrative_area_level_2']/long_name/text()")
Dim totalCoords As Integer
With mainWS
.Range(.Cells(startRow, 1), .Cells(startRow, 4)).Interior.ColorIndex = 40
.Range(.Cells(startRow, 1), .Cells(startRow, 4)).Borders.Value = 1
.Range("A" & startRow).Value = "Lookup Address: " & strAddress
.Range("B" & startRow).Value = "Latitude"
.Range("C" & startRow).Value = "Longitude"
.Range("D" & startRow).Value = "Total Coordinates: " & latitudenodes.Length
If latitudenodes.Length = 0 And addressNodes.Length = 0 And countyNodes.Length = 0 Then
mainWS.Cells(startRow + 1, 1).Value = "No such address found for '" & strAddress & "'"
End If
For i = 0 To (latitudenodes.Length - 1)
tempi = i
latitude = latitudenodes(i).NodeValue
longitude = LongitudeNodes(i).NodeValue
altAddress = addressNodes(i).NodeValue
county = countyNodes(i).NodeValue ' THIS IS THE LINE THAT THROWS THE ERROR!!!!!!-----------
i = .Cells(40000, 1).End(xlUp).Row + 1
.Range(.Cells(i, 2), .Cells(i, 3)).Borders.Value = 1
.Range("B" & i).Value = latitude
.Range("C" & i).Value = longitude
.Range("A" & i).Value = altAddress
.Range("E" & i).Value = county
i = tempi
Next i
lastRow = .Cells(1, 1).End(xlDown).Row
If lastRow = 1048576 Then lastRow = 2
End With 'End the With mainWS
startRow = lastRow + 1
Next k
lastRow = mainWS.UsedRange.Rows.Count
For i = 2 To lastRow
If IsEmpty(mainWS.Cells(i, 4)) Then
mainWS.Cells(i, 4).FormulaR1C1 = "=HYPERLINK(""https://www.google.com/maps/place//@""&RC[-2]&"",""&RC[-1]&"",16z/data=!3m1!4b1!4m2!3m1!1s0x0:0x0"",""Link"")"
End If
Next i
End Function
如果我在A列中有一个地址列表,这个宏可以很好地运行许多地址......但是,在某些点之后(似乎是i
> = 28时),尝试时设置county = countyNodes(i).NodeValue
我收到错误:
对象变量或未设置块。
为什么?对于任何其他内容(latitude
,longitude
,altAddress
),它不会执行此操作。与实际的XML有关...
感谢您的任何想法!
编辑:这是一个XML页面,加载后会导致错误:Link
每个位置都有administrative_area_level_2
个标签
EDIT2:
好的,我认为当给出多个地址时会出现问题。在我的A1和A2中,我有:
1600 Pennsylvania
1600 Pennsylvania Ave, Washington DC
因此,当Google查找1600 Pennsylvania
时,有30种可能的匹配。代码运行时没有问题UNTIL最终的第30个地址(“宾夕法尼亚州,巴拿马,OK 74951,美国”),来自this XML page。
所以,我认为错误已经缩小,只有当找到多个匹配时才会发生在最后一个地址上。
Function fnReadXMLByTags(address As String) As String
' Part of of adapted from http://excel-macro.tutorialhorizon.com/vba-excel-read-data-from-xml-file/
Dim mainWorkBook As Workbook
Dim mainWS As Worksheet
Dim addressArray()
Dim addressArrayLen As Integer
Dim tempi As Integer
Dim latitude As Double, longitude As Double
Dim county As String, altAddress As String
Application.ScreenUpdating = False
'Let's add the addresses to look up into our array:
lastRow = Cells(50000, 1).End(xlUp).row
If lastRow > 1 Then
addressArray() = Range(Cells(1, 1), Cells(lastRow, 1))
Else
addressArray() = Range(Cells(1, 1), Cells(2, 1))
End If
addressArrayLen = UBound(addressArray) - LBound(addressArray) + 1
Set mainWorkBook = ActiveWorkbook
Set mainWS = ActiveSheet ' Sheets("Sheet1")
mainWS.Range("A:A").Clear
Set oXMLFile = CreateObject("Microsoft.XMLDOM")
Dim startRow As Integer, adrRow As Integer
startRow = Cells(50000, 1).End(xlUp).row
For k = LBound(addressArray) To UBound(addressArray)
If addressArray(k, 1) = "" Then Exit For
strAddress = addressArray(k, 1) ' URLEncode(Address)
'Assemble the query string
strQuery = "http://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
' Debug.Print strQuery
' strQuery = "C:\Users\lportmann.REKERDRES\Desktop\xml.xml"
XMLFileName = strQuery
oXMLFile.async = False
oXMLFile.Load (XMLFileName)
Set resultnodes = oXMLFile.SelectNodes("/GeocodeResponse/result")
With mainWS
.Range(.Cells(startRow, 1), .Cells(startRow, 4)).Interior.ColorIndex = 40
.Range(.Cells(startRow, 1), .Cells(startRow, 4)).Borders.Value = 1
.Range("A" & startRow).Value = "Lookup Address: " & strAddress
.Range("B" & startRow).Value = "Latitude"
.Range("C" & startRow).Value = "Longitude"
.Range("D" & startRow).Value = "Total Coordinates: " & resultnodes.Length
If resultnodes.Length = 0 Then
.Cells(startRow + 1, 1).Value = "No address found for " & strAddress
lastRow = .Cells(1, 1).End(xlDown).row
If lastRow = 1048576 Then lastRow = 2
startRow = lastRow + 1
End If
Dim n
For Each n In resultnodes
Set latitudenodes = n.SelectSingleNode("geometry/location/lat")
Set LongitudeNodes = n.SelectSingleNode("geometry/location/lng")
Set addressNodes = n.SelectSingleNode("formatted_address")
Set countyNodes = n.SelectSingleNode("address_component[type='administrative_area_level_2']/long_name")
Set partialmatch = n.SelectSingleNode("partial_match")
Set statenodes = n.SelectSingleNode("address_component[type='administrative_area_level_1']/long_name")
If Not latitudenodes Is Nothing Then latitude = latitudenodes.Text
If Not LongitudeNodes Is Nothing Then longitude = LongitudeNodes.Text
If Not addressNodes Is Nothing Then altAddress = addressNodes.Text
If Not countyNodes Is Nothing Then
county = countyNodes.Text
Debug.Print altAddress & " is in " & county & ". " & strQuery
ElseIf countyNodes Is Nothing Then county = ""
End If
If Not statenodes Is Nothing Then
State = statenodes.Text
ElseIf statenodes Is Nothing Then State = ""
End If
If Not partialmatch Is Nothing Then
pmatch = partialmatch.Text
End If
Debug.Print pmatch
If resultnodes.Length = 0 Then
mainWS.Cells(startRow + 1, 1).Value = "No such address found for '" & strAddress & "'"
End If
i = .Cells(40000, 1).End(xlUp).row + 1
.Range(.Cells(i, 2), .Cells(i, 3)).Borders.Value = 1
.Range("A" & i).Value = altAddress
.Range("A" & i).HorizontalAlignment = xlRight
.Range("B" & i).Value = latitude
.Range("C" & i).Value = longitude
.Range("E" & i).Value = county
.Range("F" & i).Value = IIf(pmatch = "true", "Partial Match", "Exact match")
.Range("G" & i).Value = State
lastRow = .Cells(1, 1).End(xlDown).row
If lastRow = 1048576 Then lastRow = 2
startRow = lastRow + 1
pmatch = ""
Next n
End With
Next k
lastRow = mainWS.UsedRange.Rows.Count
For i = 2 To lastRow
If IsEmpty(mainWS.Cells(i, 4)) Then
mainWS.Cells(i, 4).FormulaR1C1 = "=HYPERLINK(""https://www.google.com/maps/place//@""&RC[-2]&"",""&RC[-1]&"",16z/data=!3m1!4b1!4m2!3m1!1s0x0:0x0"",""Link"")"
End If
Next i
ActiveWindow.Zoom = 60
Application.ScreenUpdating = True
End Function
答案 0 :(得分:2)
以下是我认为你需要解决的问题。首先,使用<result>
检索所有selectNodes()
个节点:
Set objResultNodes = oXMLFile.selectNodes("/GeocodeResponse/result")
然后,迭代这些<result>
节点中的每一个,并使用带有相对路径的selectSingleNode()
来查找与您的查询匹配的每个<result>
下方的子项。请注意我们如何从geometry/...
开始 - 基于现有节点(<result>
)的相对路径。
For Each n In objResultNodes
Set lat = n.selectSingleNode("geometry/location/lat")
Set lng = n.selectSingleNode("geometry/location/lng")
' ... your other searches
If Not lat Is Nothing Then .Range("B" & i).Value = lat.Text
If Not lng Is Nothing Then .Range("C" & i).Value = lng.Text
' ... your other searches
Next
我就是这样做的。这样,您可以将每个<result>
作为一个单元进行处理,并且能够判断何时administrative_area_level_2
或其他某些子节点不可用。