• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Google Maps Distance Matrix API Key Afstand en Tijd / Distance and Duration

Status
Niet open voor verdere reacties.

alphamax

Terugkerende gebruiker
Lid geworden
16 mrt 2011
Berichten
2.654
Besturingssysteem
Windows 11 en-US
Office versie
Office 2007 nl-NL
google maps distance matrix api key distance duration afstand tijd request
Je hebt nu een API-Key nodig om gegevens van google maps te halen.

Deze code:
  • Vraagt alleen maar gegevens op bij verandering van de broncellen;
  • Negeert lege broncellen en vraag daarom dan geen gegevens op;
  • Geeft een overzicht per dag en per maand hoeveel request er al gebruikt zijn en hoeveel er nog resteren;
  • Slaat het aantal requests op na opslaan en afsluiten.
Zodoende worden zo min mogelijk requests verspild en houd je overzicht.

Code:
[SIZE=2]Option Explicit

Public Function DistanceMatrix(strOrigin As String, strDestination As String, strMode As String, strLanguage As String, strResult As String) As String()    'am_2018

'    https://developers.google.com/maps/documentation/distance-matrix/intro?hl=nl
'    strMode = driving, walking, bicycling
'    strLanguage = nl, de, en, fr
'    strResult = value, text

    Const API_KEY As String = "AIza..................................."
    Const REQUESTS_PER_MONTH As Long = 40000

    Dim astrDistanceMatrix(0 To 3) As String
    Dim astrRequest() As String
    Dim strStatus As String

    With ThisWorkbook.CustomDocumentProperties
        On Error Resume Next
        If .Item("Request").Value = False Then
            .Add "Request", False, msoPropertyTypeString, "0,0,0,0,0,0"
        End If
        On Error GoTo 0
        astrRequest = Split(.Item("Request").Value, ",")
    End With

    If Val(astrRequest(0)) <> Day(Now) Then
        astrRequest(0) = Day(Now)
        astrRequest(1) = 0
        With WorksheetFunction
'            astrRequest(2) = REQUESTS_PER_MONTH \ Day(.EoMonth(Now, 0))    'Requests per day in month
            astrRequest(2) = REQUESTS_PER_MONTH \ .NetworkDays(.EoMonth(Now, -1) + 1, .EoMonth(Now, 0))  'Requests per workday in month
        End With
    End If
    If Val(astrRequest(3)) <> Month(Now) Then
        astrRequest(3) = Month(Now)
        astrRequest(4) = 0
        astrRequest(5) = REQUESTS_PER_MONTH
    End If

    strOrigin = Replace(Trim(strOrigin), " ", "+")
    strDestination = Replace(Trim(strDestination), " ", "+")
    If strOrigin = vbNullString Or strDestination = vbNullString Then    'prevent empty requests
        astrDistanceMatrix(0) = "NO_ORIGIN_OR_DESTINATION"
    Else
        With CreateObject("MSXML2.DOMDOCUMENT")
            .Async = False
            .Load "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOrigin & "&destinations=" & strDestination & "&key=" & API_KEY & "&mode=" & strMode & "&language=" & strLanguage    'am_2018
            strStatus = .SelectNodes("//status")(0).Text & "," & .SelectNodes("//status")(1).Text
            If strStatus <> "OK,OK" Then
                astrDistanceMatrix(0) = strStatus
            Else
                astrRequest(1) = astrRequest(1) + 1
                astrRequest(4) = astrRequest(4) + 1
                If UCase(strResult) = "TEXT" Then
                    astrDistanceMatrix(0) = .SelectSingleNode("//duration/text").Text    'duration in days/hours/minutes with unit
                    astrDistanceMatrix(1) = .SelectSingleNode("//distance/text").Text    'distance in meters/kilometers with unit
                Else
                    astrDistanceMatrix(0) = .SelectSingleNode("//duration/value").Text    'duration in seconds without unit
                    astrDistanceMatrix(1) = .SelectSingleNode("//distance/value").Text     'distance in meters without unit
                End If
                astrDistanceMatrix(2) = "day: request " & astrRequest(1) & " of " & astrRequest(2) & ", " & astrRequest(2) - astrRequest(1) & " requests remain."
                astrDistanceMatrix(3) = "month: request " & astrRequest(4) & " of " & astrRequest(5) & ", " & astrRequest(5) - astrRequest(4) & " requests remain."
            End If
            ThisWorkbook.CustomDocumentProperties("Request").Value = Join(astrRequest, ",")
        End With
    End If
    DistanceMatrix = astrDistanceMatrix
End Function
[/SIZE]
 

Bijlagen

  • helpmij google maps distance matrix api key.xlsm
    20,6 KB · Weergaven: 864
Laatst bewerkt:
Ik krijg in O2010 alleen maar foutmeldingen. Zie niet zo goed wat er fout gaat, maar hij klapt op de .Load regel.
 
Het zou waarschijnlijk efficienter zijn om niet telkens createobject aan te roepen bij iedere function call. Beter is om een module-level objectvariabele op te nemen en die eenmalig te initialiseren.
 
Is Openstreetmaps geen alternatief ?
 
Het zou waarschijnlijk efficienter zijn om niet telkens createobject aan te roepen bij iedere function call. Beter is om een module-level objectvariabele op te nemen en die eenmalig te initialiseren.
Hoe ziet de code in principe er dat er dan uit, in combinatie met een UDF?
 
Ik krijg in O2010 alleen maar foutmeldingen. Zie niet zo goed wat er fout gaat, maar hij klapt op de .Load regel.
Open deur, heb je een api-key ingevuld?
 
Bijvoorbeeld als volgt:
Code:
Option Explicit

Dim moXML As Object

Public Function DistanceMatrix(strOrigin As String, strDestination As String, strMode As String, strLanguage As String, strResult As String) As String()    'am_2018

'    https://developers.google.com/maps/documentation/distance-matrix/intro?hl=nl
'    strMode = driving, walking, bicycling
'    strLanguage = nl, de, en, fr
'    strResult = value, text

'JKP: Niet nodig, is default.
'    Application.Volatile (False)    'prevent old requests

    Const API_KEY As String = "AIza..................................."
    Const REQUESTS_PER_MONTH As Long = 40000

    Dim astrDistanceMatrix(0 To 3) As String
    Dim astrRequest() As String
    Dim strStatus As String

    With ThisWorkbook.CustomDocumentProperties
        On Error Resume Next
        If .Item("Request").Value = False Then
            .Add "Request", False, msoPropertyTypeString, "0,0,0,0,0,0"
        End If
        On Error GoTo 0
        astrRequest = Split(.Item("Request").Value, ",")
    End With

    If Val(astrRequest(0)) <> Day(Now) Then
        astrRequest(0) = Day(Now)
        astrRequest(1) = 0
        With WorksheetFunction
            '            astrRequest(2) = REQUESTS_PER_MONTH \ Day(.EoMonth(Now, 0))    'Requests per day in month
            astrRequest(2) = REQUESTS_PER_MONTH \ .NetworkDays(Now, .EoMonth(Now, 0))    'Requests per workday in month
        End With
    End If
    If Val(astrRequest(3)) <> Month(Now) Then
        astrRequest(3) = Month(Now)
        astrRequest(4) = 0
        astrRequest(5) = REQUESTS_PER_MONTH
    End If

    strOrigin = Replace(Trim(strOrigin), " ", "+")
    strDestination = Replace(Trim(strDestination), " ", "+")
    If strOrigin = vbNullString Or strDestination = vbNullString Then    'prevent empty requests
        astrDistanceMatrix(0) = "NO_ORIGIN_OR_DESTINATION"
    Else
        If OpenXMLLibrary Then
            With moXML
                .Async = False
                .Load "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOrigin & "&destinations=" & strDestination & "&key=" & API_KEY & "&mode=" & strMode & "&language=" & strLanguage    'am_2018
                strStatus = .SelectNodes("//status")(0).Text & "," & .SelectNodes("//status")(1).Text
                If strStatus <> "OK,OK" Then
                    astrDistanceMatrix(0) = strStatus
                Else
                    astrRequest(1) = astrRequest(1) + 1
                    astrRequest(4) = astrRequest(4) + 1
                    If UCase(strResult) = "TEXT" Then
                        astrDistanceMatrix(0) = .SelectSingleNode("//duration/text").Text    'duration in days/hours/minutes with unit
                        astrDistanceMatrix(1) = .SelectSingleNode("//distance/text").Text    'distance in meters/kilometers with unit
                    Else
                        astrDistanceMatrix(0) = .SelectSingleNode("//duration/value").Text    'duration in seconds without unit
                        astrDistanceMatrix(1) = .SelectSingleNode("//distance/value").Text     'distance in meters without unit
                    End If
                    astrDistanceMatrix(2) = "day: request " & astrRequest(1) & " of " & astrRequest(2) & ", " & astrRequest(2) - astrRequest(1) & " requests remain."
                    astrDistanceMatrix(3) = "month: request " & astrRequest(4) & " of " & astrRequest(5) & ", " & astrRequest(5) - astrRequest(4) & " requests remain."
                End If
                ThisWorkbook.CustomDocumentProperties("Request").Value = Join(astrRequest, ",")
            End With
        Else
            astrDistanceMatrix = "Failed to open MS XML library"
        End If
    End If
    DistanceMatrix = astrDistanceMatrix
End Function

Private Function OpenXMLLibrary() As Boolean
    On Error Resume Next
    If moXML Is Nothing Then
        Set moXML = CreateObject("MSXML2.DOMDOCUMENT")
        If moXML Is Nothing Then
            OpenXMLLibrary = False
        Else
            OpenXMLLibrary = True
        End If
    Else
        OpenXMLLibrary = True
    End If
End Function
 
Laatst bewerkt:
Klopt, maar als je het statement helemaal weglaat dan is de functie NIET volatile.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan