Reistijd berekenen via postcodes in MS Access

[richard99]

Wie o wie kan mij helpen met onderstaande functie?
Ik heb via het internet een MS Excel tooltje gevonden om reistijd te berekenen aan de hand van ingevulde postcodes.
Ik werk niet met MS Excel maar met MS Access (2003).
Ik dacht dat ik programmaatje in MS Access wel aan de praat zou krijgen echter doe ik iets verkeerd waardoor ik geen resultaat krijg.
Iemand met ruime ervaren ziet wellicht gelijk wat ik fout doe.

Public Function BerekenPostcodesReistijd(strPostcodeStart As String, strPostcodeEind As String) As String
Dim objHTML As Object
Dim objHTTP As Object
Dim strResultaat As String
Dim strUrl_reistijd As String
    
    strUrl_reistijd = "http://maps.google.nl/maps?f=d&source=s_d&saddr=" & strPostcodeStart & "+Nederland&daddr=" & strPostcodeEind & "+Nederland"

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    Set objHTML = CreateObject("HTMLFILE")
    
    On Error GoTo ErrorGenerated
    
    With objHTTP
        .Open "GET", strUrl_reistijd, False
        .send
        strResultaat = .responseText
    End With
    
    If InStr(strResultaat, "km</") <> 0 Then
        strResultaat = Mid(strResultaat, InStr(strResultaat, "km</") - 6, 40)
        If Val(strResultaat) = 0 Then strResultaat = Mid(strResultaat, 2)
        If Val(strResultaat) = 0 Then strResultaat = Mid(strResultaat, 2)
        
        BerekenPostcodesReistijd = Split(strResultaat, "<")(0)
    End If
    
    Set objHTTP = Nothing
    Set objHTML = Nothing
    
ErrorGenerated:
If Err.number > 0 Then
    strError = Err.number & " _ " & Err.Description
    MsgBox strError, vbCritical + vbOKOnly, "Foutmelding"
End If

End Function

 

[leofact]

Ik weet veel te weinig van Acces om echt iets zinnigs te zeggen, dus loop ik alleen maar kans mijn vingers te branden. Toch een opmerking.
De (0) na de Split functie lijkt daar niet te horen. Splitfunctie
Verder wordt het gewaardeerd als je codetags gebruikt (# knop)
Mvg Leo

 

[OctaFish]

De functie is niet-specifiek voor Excel, dus die zou je zo moeten kunnen gebruiken in Access. De vraag is dus: hoe roep je 'm aan?

 

[leofact]

BerekenPostcodesReistijd = Split(strResultaat, "<")(0)

Ik bedoel niet de functie zelf, maar de (0) erachteraan. Die hoort daar m.i. niet.

 

[richard99]

Dankje voor je reactie alleen ik krijg daarvoor al geen resultaat dus de split functie komt niet eens aan de orde.

 

[OctaFish]

Dan herhaal ik mijn vraag maar weer: hoe gebruik je de functie?

 

[richard99]

Ik heb twee comboboxen in een formulier geplaatst met postcodenummers erin.
Vervolgens roep ik onderstaande code aan:
strAfstand = BerekenPostcodesReistijd(Me.cboPostcode1, Me.cboPostcode2)
MsgBox strAfstand , vbExclamation + vbOKOnly, "Reistijdberekening"

Nogmaals de waarde van de objHTTP geeft geen resultaat dus daar gaat het al verkeerd.

 

[RogerS]

Even los van de code, die heb ik niet doorgespit. Wat ik me wel kan voorstellen is dat Google deze omweg geblokkeerd heeft. Ze bieden niet voor niks de Google Maps API aan developers aan. Moet je eerst een API key aanvragen (=gratis) en dan de officiële code gebruiken. Zie ook -> https://developers.google.com/maps/documentation/distancematrix/

 

[OctaFish]

Deze constructie heeft altijd al gewerkt, en Google Maps bestaat inmiddels ook al 10 jaar. Dus daar zal het niet aan liggen.

 

[OctaFish]

Sterker nog:
als je de string in een inputbox afvangt en in een webbrowser plakt, doet-ie het gewoon:

Dim tmp
tmp = InputBox("", "", strUrl)

 

[richard99]

Heren,

Ik heb het zelf opgelost.
Ik heb "https" ipv "http" ingevuld en toen werkte het wel.

De juiste code:
Public Function BerekenPostcodesReistijd(strPostcodeStart As String, strPostcodeEind As String) As String
Dim objHTML As Object
Dim objHTTP As Object
Dim strResultaat As String
Dim strUrl_reistijd As String

strUrl_reistijd = "https://maps.google.nl/maps?f=d&source=s_d&saddr=" & strPostcodeStart & "+Nederland&daddr=" & strPostcodeEind & "+Nederland"

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Set objHTML = CreateObject("HTMLFILE")

On Error GoTo ErrorGenerated

With objHTTP
.Open "GET", strUrl_reistijd, False
.send
strResultaat = .responseText
End With

If InStr(strResultaat, "km</") <> 0 Then
strResultaat = Mid(strResultaat, InStr(strResultaat, "km</") - 6, 40)
If Val(strResultaat) = 0 Then strResultaat = Mid(strResultaat, 2)
If Val(strResultaat) = 0 Then strResultaat = Mid(strResultaat, 2)

BerekenPostcodesReistijd = Split(strResultaat, "<")(0)
End If

Set objHTTP = Nothing
Set objHTML = Nothing

ErrorGenerated:
If Err.number > 0 Then
strError = Err.number & " _ " & Err.Description
MsgBox strError, vbCritical + vbOKOnly, "Foutmelding"
End If

End Function.