0

我有一个链接"https://maps.googleapis.com/maps/api/distancematrix/xml?origins=..."可以访问以获取 XML 文件数据。

XML 文件:

<DistanceMatrixResponse>
<status>OK</status>
<origin_address>London, UK</origin_address>
<destination_address>Manchester, UK</destination_address>
<row>
<element>
<status>OK</status>
<duration>
<value>14735</value>
<text>4 hours 6 mins</text>
</duration>
<distance>
<value>335534</value>
<text>336 km</text>
</distance>
</element>
</row>
</DistanceMatrixResponse>

XML 文件结构始终相同。我需要获取单元格 A1 和<text>4 hours 6 mins</text>单元格 A2<text>336 km</text>的形式,可以说“联系数据库”。这里的另一个问题是有时可以。我可以用公式来做,但用 VBA 甚至可以吗?4,6336<text>4 hours 6 mins</text><text>1 hour 3 min</text>

我设法使它工作,以便整个 XML 文件数据位于单元格 A1 中。但是无法分离我需要的内容并粘贴到两个不同的单元格。

Sub GoogleAPI1()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Dim myurl As String

myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Contact database").Range("R86").Value _
& "&destinations=" & ThisWorkbook.Worksheets("Contact database").Range("R87").Value & "&mode=" & ThisWorkbook.Worksheets("Contact database").Range("R88").Value _
& "&key=" & ThisWorkbook.Worksheets("Contact database").Range("R82").Value

xmlhttp.Open "GET", myurl, False
xmlhttp.send
ThisWorkbook.Worksheets("Contact database").Range("R92") = xmlhttp.responseText
End Sub
4

1 回答 1

1

这是使用 VBA 获得您描述的结果的一种方法。

我提取了节点信息,然后使用正则表达式对其进行处理以将其转换为您描述的格式。

可能可以更有效地做到这一点,并进行更多或不同的错误检查,但这可能会让你开始。

Option Explicit
Sub getDurDist()
    Dim xmlDoc As DOMDocument60
    Dim xmlNode As IXMLDOMNode
    Dim sTemp As String
    Dim RE As Object, MC As Object
    Dim rDest As Range

Set xmlDoc = New DOMDocument60

'hard coded here.  Change to suit
Set rDest = Range("B1:C1")
rDest.Clear

xmlDoc.LoadXML Range("a1")
Set xmlNode = xmlDoc.SelectSingleNode("//duration/text")


sTemp = xmlNode.Text

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .Pattern = "\d+"
    If .test(sTemp) = True Then
        Set MC = .Execute(sTemp)
        rDest(1, 1) = MC(0) & "," & MC(1)
    End If
End With


Set xmlNode = xmlDoc.SelectSingleNode("//distance/text")
sTemp = xmlNode.Text
With RE
    If .test(sTemp) = True Then
        Set MC = .Execute(sTemp)
        rDest(1, 2) = MC(0)
    End If
End With

End Sub
于 2019-06-28T12:14:12.353 回答