查询XML文档 - 如何在没有结果时跳过或调整索引?

时间:2015-08-20 19:04:49

标签: xml vba excel-vba excel

(最初标题为“运行时错误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我收到错误:

  

对象变量或未设置块。

为什么?对于任何其他内容(latitudelongitudealtAddress),它不会执行此操作。与实际的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

所以,我认为错误已经缩小,只有当找到多个匹配时才会发生在最后一个地址上。

编辑:@Bond的超级大牌 - 使用他的答案,我能够最终得到这个最终的,有效的代码:

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

1 个答案:

答案 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或其他某些子节点不可用。