ik gebruik deze code maar geeft geen antwoord, dus zal er wel weer iets verkeerd staan maar wat he.
Code:
Option Compare Database
Option Explicit
Public Function BerekenPostcodes(strPostcodeStart As String, strPostcodeEind As String) As String
Dim objHTML As Object
Dim objHTTP As Object
Dim strResultaat As String
Dim strUrl_ As String
strUrl_ = "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_, 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)
BerekenPostcodes = 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
Private Sub strPostcodeEind_AfterUpdate()
Dim strAfstand As String
strAfstand = BerekenPostcodes(Me.strPostcodeStart, Me.strPostcodeEind)
MsgBox strAfstand, vbExclamation + vbOKOnly, "berekening"
End Sub
