dcsimg
Results 1 to 4 of 4

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

  1. #1

    Thread Starter
    Member
    Join Date
    Oct 2018
    Posts
    47

    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: 120
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.

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,554

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

    you could put all the destinations into an array then loop through the array

    i will try to mod the code later
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Member
    Join Date
    Oct 2018
    Posts
    47

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

    Here is the loop, but can't figure out how to make hours and min display correct in Excel point of view. Replace just makes 3 hours 2 mins -> 3,2 however to be correct it is 3,02. Also it converts 29 min to 29, when it should be 0,29. Also there might be a problem with changing "hours" and "hour" words. Sometimes there are 3 "hours", sometimes 1 "hour". Maybe regex is better in this case or it can be achieved somehow with wrapping another Replace?

    Actual XML looks like this:

    Code:
    <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>

    Code:
    Sub GoogleMapsAPIDurDist()
        Dim xmlhttp As New MSXML2.serverXMLHTTP, xmlDoc As New DOMDocument30
        Dim myurl As String, sTemp As String
        Dim APIkey As Range, TravelMode As Range
        Dim i as Long                                                ' NEW VARIABLE
    
        With ThisWorkbook.Worksheets("Other Data")
             Set APIkey = .Range("CE1")
             Set TravelMode = .Range("BY3")
    
             For i = 1 to 17 Step 4                                  ' LOOP WITH STEP    
                  myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?" _
                           & "origins=" & .Range("BY" & i).Value  _
                           & "&destinations=" & .Range("BY" & i + 1).Value _
                           & "&mode=" & TravelMode & "&key=" & APIkey   
    
                  xmlhttp.Open "GET", myurl, False
                  xmlhttp.send
                  xmlDoc.LoadXML xmlhttp.responseText
    
                  sTemp = xmlDoc.SelectSingleNode("//duration/text").Text
                  .Range("CA" & i) = Replace(Replace(sTemp, "hours", ", "), "mins", "")
    
                  sTemp = xmlDoc.SelectSingleNode("//distance/text").Text
                  .Range("CA" & i + 1) = Replace(Replace(sTemp, " km", ""), " ", ",")
             Next i
        End With
    
        Set APIkey = Nothing: Set TravelMode = Nothing
        Set xmlhttp = Nothing: Set xmlDoc = Nothing
    End Sub

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,554

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

    i would try like
    Code:
    .Range("CA" & i + 1) = Format(TimeSerial(Val(stemp), Val(Mid(stemp, InStr(stemp, "hour") + 5)), 0), "h,mm")
    as time serial returns an actual time value it is probably not what you want, but you can format however you desire

    i am not sure if this will work correctly for values of 0 hours, as i do not know how it is represented in the xml, if it just displays 0 hours or similar it may still work correctly, but if just mins with nothing for hours, try fixing like

    Code:
    pos = InStr(stemp, "hour")
    if pos > 0 then
           .Range("CA" & i + 1) = Format(TimeSerial(Val(stemp), Val(Mid(stemp, pos + 5)), 0), "h,mm")
           else
           .Range("CA" & i + 1) = Format(TimeSerial(0, Val(stemp), 0), "h,mm")
    Last edited by westconn1; Jun 30th, 2019 at 06:13 AM.
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

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