Afstanden Ophalen met behulp van Google Maps

[Evertblokdijk]

Goede dag allemaal,

heeft iemand een werkende VBA om met behulp van Google maps, aan de hand van de postcodes, een afstanden matrix te vullen ?
(Zie bijlage)

Alvast bedankt voor jullie snelle reactie

 

[robdgr]

Met gebruik van de zoekfunctie had je deze berichten gevonden.

 

[alphamax]

Vul bij Const API_KEY As String = "AIza...." je eigen API-key in.
Houd de restricties van google maps in de gaten.

Option Explicit

Private Sub CommandButton1_Click()

'    https://developers.google.com/maps/documentation/distance-matrix/intro?hl=nl

    Const API_KEY As String = "AIza...."

    Dim objElement As Object
    Dim lngElement As Long
    Dim rngDistance As Range
    Dim rngDistances As Range
    Dim strDestination As String
    Dim strOrigin As String
    Dim strStatus As String

    Set rngDistances = Range("B3").CurrentRegion

    rngDistances.Cells(1).ClearContents
    rngDistances.Offset(1, 1).ClearContents

    With Application
        strOrigin = Mid(Join(.Transpose(rngDistances.Columns(1)), "|"), 2)
        strDestination = Mid(Join(.Transpose(.Transpose(rngDistances.Rows(1))), "|"), 2)
    End With

    lngElement = -1
    With CreateObject("MSXML2.DOMDOCUMENT")
        .Async = False
        .Load "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOrigin & "&destinations=" & strDestination & "&key=" & API_KEY & "&mode=driving&language=nl"  'am_2019
        strStatus = .SelectSingleNode("/DistanceMatrixResponse/status").Text
        If strStatus = "OK" Then
            Set objElement = .SelectNodes("/DistanceMatrixResponse/row/element")
            For Each rngDistance In rngDistances
                If rngDistance.Row <> rngDistances.Rows(1).Row And rngDistance.Column <> rngDistances.Columns(1).Column Then
                    lngElement = lngElement + 1
                    strStatus = objElement.Item(lngElement).SelectSingleNode("status").Text
                    If strStatus = "OK" Then
                        rngDistance.Value = objElement.Item(lngElement).SelectSingleNode("distance/value").Text
                    Else
                        rngDistance.Value = strStatus
                    End If
                End If
            Next
        Else
            rngDistances.Cells(1).Value = strStatus
        End If
    End With

End Sub