Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 9 van 9

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

  1. #1
    Mega Senior
    Geregistreerd
    16 maart 2011
    Locatie
    Weert
    Vraag is opgelost

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

    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:
    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
    
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door alphamax : 8 november 2018 om 17:36

  2. #2
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Ik krijg in O2010 alleen maar foutmeldingen. Zie niet zo goed wat er fout gaat, maar hij klapt op de .Load regel.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  3. #3
    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.
    Groetjes,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  4. #4
    Giga Honourable Senior Member
    Verenigingslid
    snb's avatar
    Geregistreerd
    12 juni 2008
    Is Openstreetmaps geen alternatief ?
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  5. #5
    Mega Senior
    Geregistreerd
    16 maart 2011
    Locatie
    Weert
    Quote Origineel gepost door jkpieterse Bekijk Bericht
    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?

  6. #6
    Mega Senior
    Geregistreerd
    16 maart 2011
    Locatie
    Weert
    Quote Origineel gepost door OctaFish Bekijk Bericht
    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?

  7. #7
    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 aangepast door jkpieterse : 8 november 2018 om 16:26
    Groetjes,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  8. #8
    Mega Senior
    Geregistreerd
    16 maart 2011
    Locatie
    Weert
    Bedankt,

    Volgens deze documentatie, zie https://docs.microsoft.com/en-us/off...ation.volatile, is application.volatile bij default true.

  9. #9
    Klopt, maar als je het statement helemaal weglaat dan is de functie NIET volatile.
    Groetjes,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  10. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren