Option Explicit
'Entfernungsberechnung über Google Maps
'ohne WevBrowser
'Rückfragen an Gunthard Pupke info@showtime.de
Private Sub Form_Load()
    Dim GoogleText, Von, Nach, Zeit, Stunden, Minuten, KM As String
    Dim Start As Integer
 
    'verschiedene Von - Nach
    Von = "D 23847, Mühlenbrook 1"
    Nach = "D 20144, Kielortallee 8"
    Nach = "D 21614, Apensenerstr. 100a"
    Von = "DK Kopenhagen"
    Nach = "D Rosenheim"
    GoogleText = GetHTMLCode("https://www.google.de/maps/dir/," & Von & "/" & _
      Nach)
 
    'Kilometer extrahieren
    Start = InStr(GoogleText, "km")
    If Start > 0 Then
        KM = Mid$(GoogleText, Start - 8, 12)
        Debug.Print "1-", KM
        Start = InStr(KM, Chr$(34))
        If Start > 0 Then
            KM = Mid$(KM, Start + 1, 12)
            Debug.Print "2-", KM
            Start = InStr(KM, Chr$(34))
            If Start > 0 Then
                KM = Mid$(KM, 1, Start - 1)
                Debug.Print "3-", KM
            End If
            Start = InStr(KM, "km")
            If Start > 0 Then
                KM = Left$(KM, Start - 2)
                Debug.Print "4-"; KM; "-"
            End If
        End If
    End If
 
    'Fahrzeit extrahieren
    Start = InStr(GoogleText, "Min.")
    If Start > 0 Then
        Zeit = Mid$(GoogleText, Start - 12, 20)
        Debug.Print "5-", Zeit
        Start = InStr(Zeit, Chr$(34))
        If Start > 0 Then
            Zeit = Mid$(Zeit, Start + 1, 20)
            Debug.Print "6-", Zeit
            Start = InStr(Zeit, Chr$(34))
            If Start > 0 Then
                Zeit = Mid$(Zeit, 1, Start - 1)
                Debug.Print "7-", Zeit
            End If
 
            'Zerlegen in Stunden
            Start = InStr(Zeit, "Std.")
            If Start > 0 Then
                Stunden = Left$(Zeit, 8)
                Start = InStr(Stunden, " ")
                If Start > 0 Then
                    Stunden = Left$(Stunden, Start - 1)
                    Debug.Print "8-"; Stunden; "-"
                Else
                    Stunden = 0
                End If
            End If
            'Zerlegen in Minuten
            Start = InStr(Zeit, " Min.")
            If Start > 0 Then
                Minuten = Mid$(Zeit, Start - 2, 2)
                Debug.Print "9-"; Minuten; "-"
                Minuten = Trim$(Minuten)
                Debug.Print "10-"; Minuten; "-"
 
 
            Else
                Minuten = 0
            End If
        End If
    End If
 
    Debug.Print "KM  ="; KM
    Debug.Print "Std.="; Stunden
    Debug.Print "Min.="; Minuten
End Sub
 
Function GetHTMLCode(strURL) As String
    Dim strReturn                   ' As String
    Dim objHTTP                     ' As MSXML.XMLHTTPRequest
    If Len(strURL) = 0 Then Exit Function
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.open "GET", strURL, False
    objHTTP.send                    'Get it.
    strReturn = objHTTP.responseText
    Set objHTTP = Nothing
    GetHTMLCode = strReturn
End Function