dcsimg
Results 1 to 4 of 4

Thread: Get Google Maps XML data, parse it and input to Excel cells

Threaded View

  1. #1

    Thread Starter
    Member
    Join Date
    Oct 2018
    Posts
    46

    Get Google Maps XML data, parse it and input to Excel cells

    I managed to get a working solution for getting Google Maps XML data, parsing it and inputting to Excel cells. However my next intention get it working for several requests when there are 5 different locations to be analyzed and data from each XML should be inputted to different cells. I am able to do it by 5 different macros and then use like:


    Code:
        Sub Master()
        Call macro1
        Call macro2
        Call macro3
        Call macro4
        Call macro5
        End Sub
    I was thinking maybe I can make code faster by making just one macro and including all in there. Now I stuck with it. Maybe by including just two or three destination variants somebody can give me a hint how to proceed?


    I have data on Worksheet "Other Data" (you can see first one working after running my current macro, API key is not fully displayed for reason):


    Name:  5x1Nv.jpg
Views: 117
Size:  24.6 KB

    https://i.stack.imgur.com/5x1Nv.png


    Then I have tried to make them all work, but got stuck. I use `DOMDocument30` because I would like this code to work in Excel 2013 as well. Here is my current macro:


    Code:
        Sub GoogleMapsAPIDurDist()
            Dim xmlhttp As Object
            Dim xmlhttp_1 As Object
            Dim xmlhttp_2 As Object
            Dim xmlhttp_3 As Object
            Dim xmlhttp_4 As Object
            Dim myurl As String
            Dim myurl_1 As String
            Dim myurl_2 As String
            Dim myurl_3 As String
            Dim myurl_4 As String
            Dim xmlDoc As DOMDocument30
            Dim xmlNode As IXMLDOMNode
            Dim sTemp As String
            Dim RE As Object, MC As Object
            Dim rDest As Range
            Dim APIkey As Range
            Dim TravelMode As Range
        
            Set xmlDoc = New DOMDocument30
            Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
            Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
            Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")
            
            myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY1").Value _
            & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY2").Value & "&mode=" & TravelMode & "&key=" & APIkey
            
            myurl_1 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY5").Value _
            & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY6").Value & "&mode=" & TravelMode & "&key=" & APIkey
            
            myurl_2 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY9").Value _
            & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY10").Value & "&mode=" & TravelMode & "&key=" & APIkey
            
            myurl_3 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY13").Value _
            & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY14").Value & "&mode=" & TravelMode & "&key=" & APIkey
            
            myurl_4 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY17").Value _
            & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY18").Value & "&mode=" & TravelMode & "&key=" & APIkey
            
            xmlhttp.Open "GET", myurl, False
            
            'xmlhttp.Open "GET", myurl_1, False
            
            'xmlhttp.Open "GET", myurl_2, False
            
            'xmlhttp.Open "GET", myurl_3, False
            
            'xmlhttp.Open "GET", myurl_4, False
            xmlhttp.send
        
            'hard coded here.  Change to suit
            Set rDest = ThisWorkbook.Worksheets("Other Data").Range("CA2")
            
            xmlDoc.LoadXML xmlhttp.responseText
            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(0, 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, 1) = MC(0)
                End If
            End With
        
        End Sub
    Last edited by mrwad; Jun 28th, 2019 at 12:33 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width