Toon posts:

VBA reistijd Google Maps API

Pagina: 1
Acties:

Vraag

dinsdag 22 oktober 2019 22:15

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Goedendag,

In Excel probeer ik al een ruime tijd mijn reistijd bestand weer werkend te krijgen. Ik ben op de hoogte dat dit sinds 2e helft 2018 niet meer mogelijk is zonder API code. Deze code heb ik bij Google opgevraagd en wil dit werkend krijgen (met het gratis tegoed) voordat ik er geld voor ga betalen en waarschijnlijk blijf ik wel binnen het budget.
Ook weet ik dat er meerdere fora zijn waar dit onderwerp besproken is. Maar bij geen enkele krijg ik het bestand werkend. Ik blijf terugkeren op resultaat #WAARDE of #NAAM.
Hopelijk kan iemand mij hier verder helpen.

De code die ik gebruik staat onderaan (en werkte voorheen prima).Heb ik overigens niet zelf verzonnen.
Nu moet de API code er in, dit heb ik ook op meerdere manieren gedaan, bijvoorbeeld deze: maar er komt nog steeds geen tijdberekening uit (YOUR_API_KEY) vervangen door de AIZ code.

Is er iemand de me op weg kan helpen?
Alvast bedankt.
Mathie88
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

Link = "https://maps.googleapis.com/maps/api/distancematrix/json?key=YOUR_API_KEY&origins="

''''''''''''''''''''''''''''''''''
' Reistijd berekenen
'
' start = startlocatie
' eind = eindlocatie
' vervoer = manier waarop te reizen
' eenheid = manier van tijdspresentatie
'
''''''''''''''''''''''''''''''''''

Public Function G_REISTIJD(start As String, eind As String, Optional vervoer As Variant, Optional eenheid As Variant) As Variant

Dim Verv As String
Dim Eenh As String
Dim Link As String
Dim Bestemming As String
Dim Mode As String
Dim Taal As String
Dim Min As Integer
Dim Uur As Integer
Dim Sec As Integer

''' Link opbouw '''
    Link = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    Bestemming = "&destinations="
    Mode = "&mode="
    Taal = "&language=nl"

''' Controleren op waarde in vervoer '''
' Openbaar vervoer is een registratienummer voor nodig bij google '
    If IsMissing(vervoer) = True Or IsEmpty(vervoer) = True Then
        Verv = "driving"
    Else
        If vervoer > 2 Then
          Verv = "driving"
        Else
          Select Case vervoer
             Case 0: Verv = "driving"
             Case 1: Verv = "walking"
             Case 2: Verv = "bicycling"
          End Select
        End If
    End If
    
''' Controleren op waarde in eenheid '''
    If IsMissing(eenheid) = True Or IsEmpty(eenheid) = True Then
        Eenh = 0
    Else
        If eenheid > 3 Then
          Eenh = 0
        Else
          Eenh = eenheid
        End If
    End If
    
''' Oproepen informatie '''
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = Link & Replace(start, " ", "+") & Bestemming & Replace(eind, " ", "+") & Mode & Verv & Taal
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
''' Als POST tekst niet klopt '''
    If InStr(objHTTP.responseText, """duration"" : {") = 0 Then GoTo Error
    
''' Tijd opzoeken '''
    tijd = Right(objHTTP.responseText, Len(objHTTP.responseText) - InStrRev(objHTTP.responseText, """value"" : ") - 9)
    
''' Tijd naar seconden, minuten en uren '''
    Sec = CDbl(Replace(Split(tijd)(0), ".", ","))
    Min = Int((Sec - (Int(Sec / 3600) * 3600)) / 60)
    Minn = Int(Round((Sec - (Int(Sec / 3600) * 3600)) / 60))
    Uur = Int(Sec / 3600)
    
''' Als eenheid in 00:00 '''
    Kort = Format(Uur, "00") & ":" & Format(Min, "00")
    
''' Als eenheid in 00:00:00 '''
    Lang = Format(Uur, "00") & ":" & Format(Min, "00") & ":" & Format(((Sec Mod 60)), "00")
    
''' Als eenheid in tekst '''
    If Uur > 0 Then
        Tekst = Uur & " u. " & Minn & " min."
    Else
        Tekst = Minn & " min."
    End If
    
''' Eindresultaat maken '''
    Select Case Eenh
        Case 0: G_REISTIJD = Kort
        Case 1: G_REISTIJD = Lang
        Case 2: G_REISTIJD = Sec
        Case 3: G_REISTIJD = Tekst
    End Select
    Exit Function
    
''' Error uitgang '''
Error:
    G_REISTIJD = CVErr(xlErrNA)

End Function

[ Voor 1% gewijzigd door Hero of Time op 25-10-2019 20:51 . Reden: prettify code en klap in met quote ]

Alle reacties

vrijdag 25 oktober 2019 11:24

Acties:
  • 0 Henk 'm!
  • TheVMaster
  • Registratie: Juli 2001
  • Laatst online: 00:24

TheVMaster

Moderator WOS
Eh....de laatste keer dat ik het checkte was Excel geen onderdeel van de Windows Client, dus ik verplaats hem even naar CSA.

vrijdag 25 oktober 2019 19:07

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Bedankt voor de hulp

vrijdag 25 oktober 2019 19:11

Acties:
  • 0 Henk 'm!
  • spone
  • Registratie: Mei 2002
  • Niet online

spone

Geen idee hoe die api werkt, maar initieel zie ik staan:

Visual Basic:
1

Link = "https://maps.googleapis.com/maps/api/distancematrix/json?key=YOUR_API_KEY&origins="
en verderop zie ik:
Visual Basic:
1
2
3
4
5
6
7

''' Link opbouw '''
Link = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
Bestemming = "&destinations="
Mode = "&mode="
Taal = "&language=nl"
[...]
Url = Link & Replace(start, " ", "+") & Bestemming & Replace(eind, " ", "+") & Mode & Verv & Taal
Met nergens meer een verwijzing naar je key.

Het zou trouwens beter leesbaar zijn als je de moeite neemt om je code even tussen code tags te zetten :)

[ Voor 9% gewijzigd door spone op 25-10-2019 19:12 ]

i5-14600K | 32GB DDR5-6000 | RTX 5070 - MacBook Pro M1 Pro 14" 16/512

zaterdag 26 oktober 2019 18:53

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Dank voor de reactie.
Deze VBA is een voorbeeld hoe het voorheen wel werkte, nu niet meer vanwege die API. Ik heb ook al meerdere pogingen gedaan om de API toe te voegen maar zonder resultaat.

zaterdag 26 oktober 2019 23:15

Acties:
  • 0 Henk 'm!
  • spone
  • Registratie: Mei 2002
  • Niet online

spone

Probeer anders eens objHTTP.responseText in een veld te zetten of op een of andere manier te tonen? Dan kan je in elk geval zien waar de API het niet mee eens is.

i5-14600K | 32GB DDR5-6000 | RTX 5070 - MacBook Pro M1 Pro 14" 16/512

zondag 27 oktober 2019 12:23

Acties:
  • 0 Henk 'm!
  • nescafe
  • Registratie: Januari 2001
  • Laatst online: 22:08

nescafe

Mathie88 schreef op zaterdag 26 oktober 2019 @ 18:53:
Ik heb ook al meerdere pogingen gedaan om de API toe te voegen maar zonder resultaat.
Kun je aangeven welke pogingen je allemaal al gedaan hebt?

Uit [Excel] Gebruik van Google API in VBA blijkt dat het aanpassen/toevoegen van de API-key in de URL voldoende is.

In je getoonde voorbeeld heb je Link gedefinieerd buiten de procedure terwijl deze binnen de procedure niet is aangepast (regel 26 is ongewijzigd).

* Barca zweert ook bij fixedsys... althans bij mIRC de rest is comic sans

maandag 28 oktober 2019 17:42

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Zoals in onderstaande heb ik bijvoorbeeld geprobeerd. Ik krijg als uitkomst #N/B.
Dan is dus de sleutel bijgeplaatst en de link bij oproepen informatie aangepast zodat hij ook naar de sleutel kijkt. Ik heb de API iets aangepast, zodat deze niet openbaar staat.
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

''''''''''''''''''''''''''''''''''
' Reistijd berekenen
'
' start = startlocatie
' eind = eindlocatie
' vervoer = manier waarop te reizen
' eenheid = manier van tijdspresentatie
'
''''''''''''''''''''''''''''''''''

Public Function G_REISTIJD(start As String, eind As String, Optional vervoer As Variant, Optional eenheid As Variant) As Variant

Dim Verv As String
Dim Eenh As String
Dim Link As String
Dim Bestemming As String
Dim Mode As String
Dim Taal As String
Dim Min As Integer
Dim Uur As Integer
Dim Sec As Integer

''' Link opbouw '''
    Link = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    Bestemming = "&destinations="
    Mode = "&mode="
    Taal = "&language=nl"
    Sleutel = "&key=<AIzaDGkjHKSAEDFjha2342D2345234OcasdfOIUYKJ>"

''' Controleren op waarde in vervoer '''
' Openbaar vervoer is een registratienummer voor nodig bij google '
    If IsMissing(vervoer) = True Or IsEmpty(vervoer) = True Then
        Verv = "driving"
    Else
        If vervoer > 2 Then
          Verv = "driving"
        Else
          Select Case vervoer
             Case 0: Verv = "driving"
             Case 1: Verv = "walking"
             Case 2: Verv = "bicycling"
          End Select
        End If
    End If
    
''' Controleren op waarde in eenheid '''
    If IsMissing(eenheid) = True Or IsEmpty(eenheid) = True Then
        Eenh = 0
    Else
        If eenheid > 3 Then
          Eenh = 0
        Else
          Eenh = eenheid
        End If
    End If
    
''' Oproepen informatie '''
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = Link & Replace(start, " ", "+") & Bestemming & Replace(eind, " ", "+") & Mode & Verv & Taal & Sleutel
    objHTTP.Open "GET", Url, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
''' Als POST tekst niet klopt '''
    If InStr(objHTTP.responseText, """duration"" : {") = 0 Then GoTo Error
    
''' Tijd opzoeken '''
    tijd = Right(objHTTP.responseText, Len(objHTTP.responseText) - InStrRev(objHTTP.responseText, """value"" : ") - 9)
    
''' Tijd naar seconden, minuten en uren '''
    Sec = CDbl(Replace(Split(tijd)(0), ".", ","))
    Min = Int((Sec - (Int(Sec / 3600) * 3600)) / 60)
    Minn = Int(Round((Sec - (Int(Sec / 3600) * 3600)) / 60))
    Uur = Int(Sec / 3600)
    
''' Als eenheid in 00:00 '''
    Kort = Format(Uur, "00") & ":" & Format(Min, "00")
    
''' Als eenheid in 00:00:00 '''
    Lang = Format(Uur, "00") & ":" & Format(Min, "00") & ":" & Format(((Sec Mod 60)), "00")
    
''' Als eenheid in tekst '''
    If Uur > 0 Then
        Tekst = Uur & " u. " & Minn & " min."
    Else
        Tekst = Minn & " min."
    End If
    
''' Eindresultaat maken '''
    Select Case Eenh
        Case 0: G_REISTIJD = Kort
        Case 1: G_REISTIJD = Lang
        Case 2: G_REISTIJD = Sec
        Case 3: G_REISTIJD = Tekst
    End Select
    Exit Function
    
''' Error uitgang '''
Error:
    G_REISTIJD = CVErr(xlErrNA)

End Function

[ Voor 0% gewijzigd door Hero of Time op 28-10-2019 18:53 . Reden: Dit had je in je Ts kunnen nakijken ]

maandag 28 oktober 2019 17:43

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Ik roep de duur trouwens op door deze formule:

=G_reistijd(D3;E3;F3;G3)*2

maandag 28 oktober 2019 17:47

Acties:
  • 0 Henk 'm!
  • nescafe
  • Registratie: Januari 2001
  • Laatst online: 22:08

nescafe

Kun je een breakpoint op regel 100 zetten (of het woord Stop als nieuwe regel hier plaatsen) en dan met het Watch-venster de variable Err uitlezen?

* Barca zweert ook bij fixedsys... althans bij mIRC de rest is comic sans

woensdag 30 oktober 2019 16:27

Acties:
  • 0 Henk 'm!
  • Mathie88
  • Registratie: Oktober 2019
  • Laatst online: 14-11-2022

Mathie88

Topicstarter
Hoi Nescafe,

Ik heb op regel 100 een witregel toegevoegd en via watchvenster de samenvatting opgevraagd, is dit wat je bedoelt?

Hij blijft #N/B aangeven

woensdag 30 oktober 2019 17:06

Acties:
  • 0 Henk 'm!
  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Mathie88 schreef op woensdag 30 oktober 2019 @ 16:27:
Hoi Nescafe,

Ik heb op regel 100 een witregel toegevoegd en via watchvenster de samenvatting opgevraagd, is dit wat je bedoelt?

Hij blijft #N/B aangeven
Natuurlijk doet hij dat. In regel 100 geef je keihard op dat bij elke fout in de aanroep #N/B moet worden teruggegeven.


Zet dat breakpoint eens op regel 61 en op 64 en controleer de waarden van 'url' en van 'objHTTP.responseText' of gebruik debug.print url, objHTTP.responseText op regel 64 en kijk met ctrl G wat de inhoud is van die variabelen.

[ Voor 81% gewijzigd door Lustucru op 31-10-2019 11:03 ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

woensdag 22 januari 2020 12:30

Acties:
  • +1 Henk 'm!
  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

For future reference: toevallig had ik een soortgelijke functie nodig. De volledige VBA code:

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

Option Explicit

Const baseUri = "https://maps.googleapis.com/maps/api/distancematrix/xml?key=[Jouw_API_key_Hier"


Public Function AFSTAND(Adres1 As String, Adres2 As String, Optional Mode As String = "driving", Optional Time As Integer = 0) As Variant
    On Error GoTo foutafhandeling
    Dim url As String, objHTTP As Object, response As String
    'check op lege invoer
    If Len(Adres1) = 0 Or Len(Adres2) = 0 Then
        AFSTAND = 0
        Exit Function
    End If
    'roep de api aan, vraag XML terug
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", baseUri & "&origins=" & Adres1 & "&destinations=" & Adres2 & "&mode=" & Mode, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    'haal de eerste resultaatrij op uit de responsetekst
    response = getSingleNode(objHTTP.responsetext, "row")
    'Controleer de status
    If getSingleNode(response, "status") = "OK" Then
        'als timeflag is gezet geeft tijd terug, anders afstand
        If Time = 0 Then
            AFSTAND = Round(Val(getSingleNode(getSingleNode(response, "distance"), "value")) / 1000, 1)
        Else
            AFSTAND = (getSingleNode(getSingleNode(response, "duration"), "value")) / 86400
        End If
    Else
        'geef event. de foutmelding van de api terug
        AFSTAND = getSingleNode(response, "status")
    End If
    
    Exit Function
foutafhandeling:
  'geef vba fouten terug
  AFSTAND = Err.Description
End Function

Private Function getSingleNode(xml As String, nodeName As String) As String
    'hulpfunctie om uit een xml-string de inhoud van een node te halen
    Dim p As Integer, p2 As Integer
    p = InStr(xml, "<" & nodeName & ">")
    If p > 0 Then
        p2 = InStr(p + 1, xml, "</" & nodeName & ">")
        If p2 > 0 Then
            getSingleNode = Mid(xml, p + Len(nodeName) + 2, p2 - (p + Len(nodeName) + 2))
            Exit Function
        End If
    End If
    getSingleNode = ""
End Function

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

vrijdag 13 augustus 2021 15:06

Acties:
  • 0 Henk 'm!
  • Jeffry1
  • Registratie: Augustus 2021
  • Laatst online: 18-08-2021

Jeffry1

Hoi,

Heb al diverse VBA codes geprobeerd om de afstand tussen twee postcodes te berekenen. De laatste die ik heb geprobeerd is die in deze melding van 'Lustucru'. Heb ook mijn eigen API Key ingevuld maar als ik in Excel =AFSTAND(A2;B2;C2;D2) invoer dan blijft de cel leeg. In A2 en B2 heb ik postcodes staan en in C2 en D2 heb ik 0 ingevoerd.

Weet iemand wat ik precies verkeerd doe?

Alvast bedankt!

dinsdag 15 augustus 2023 12:40

Acties:
  • 0 Henk 'm!
  • CIVI
  • Registratie: Augustus 2023
  • Laatst online: 15-08-2023

CIVI

Ik heb ook al verschillende scripts gezocht en geen enkele gevonden die goed werkt.
Deze bovenstaande geeft ook een leeg vakje terug, nadat ik mijn API code heb ik ingevuld (zie onder).

De formule in excel is = afstand (cel1; cel 2)
De uitkomst is leeg

Kan iemand mij verder helpen?

Option Explicit

Const baseUri = "https://maps.googleapis.com/maps/api/distancematrix/xml?key=[..eigen API code.."


Public Function AFSTAND(Adres1 As String, Adres2 As String, Optional Mode As String = "driving", Optional Time As Integer = 0) As Variant
On Error GoTo foutafhandeling
Dim url As String, objHTTP As Object, response As String
'check op lege invoer
If Len(Adres1) = 0 Or Len(Adres2) = 0 Then
AFSTAND = 0
Exit Function
End If
'roep de api aan, vraag XML terug
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "GET", baseUri & "&origins=" & Adres1 & "&destinations=" & Adres2 & "&mode=" & Mode, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
'haal de eerste resultaatrij op uit de responsetekst
response = getSingleNode(objHTTP.responsetext, "row")
'Controleer de status
If getSingleNode(response, "status") = "OK" Then
'als timeflag is gezet geeft tijd terug, anders afstand
If Time = 0 Then
AFSTAND = Round(Val(getSingleNode(getSingleNode(response, "distance"), "value")) / 1000, 1)
Else
AFSTAND = (getSingleNode(getSingleNode(response, "duration"), "value")) / 86400
End If
Else
'geef event. de foutmelding van de api terug
AFSTAND = getSingleNode(response, "status")
End If

Exit Function
foutafhandeling:
'geef vba fouten terug
AFSTAND = Err.Description
End Function

Private Function getSingleNode(xml As String, nodeName As String) As String
'hulpfunctie om uit een xml-string de inhoud van een node te halen
Dim p As Integer, p2 As Integer
p = InStr(xml, "<" & nodeName & ">")
If p > 0 Then
p2 = InStr(p + 1, xml, "</" & nodeName & ">")
If p2 > 0 Then
getSingleNode = Mid(xml, p + Len(nodeName) + 2, p2 - (p + Len(nodeName) + 2))
Exit Function
End If
End If
getSingleNode = ""
End Function

donderdag 17 augustus 2023 11:18

Acties:
  • 0 Henk 'm!
  • Lustucru
  • Registratie: Januari 2004
  • Niet online

Lustucru

26 03 2016

Begin eens met debuggen. Plaats voor regel 20 de opdracht debug.print objhttp.responsetext
Open het venster direct met Ctrl-toets + g en roep de functie aan door in het venster te tikken debug.print afstand(“1071XX”, “3512JN”)

Plaats hier je output€

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

Pagina: 1
Reageer

Apple iPhone 16e LG OLED evo G5 Google Pixel 10 Samsung Galaxy S25 Star Wars: Outlaws Nintendo Switch 2 Apple AirPods Pro (2e generatie) Sony PlayStation 5 Pro

Tweakers is onderdeel van DPG Media B.V.
Alle rechten voorbehouden - Auteursrecht © 1998 - 2025 • Hosting door TrueFullstaq