Hilfe mit VBA Code - Entfernungen nach PLZ

[Bengo]

Hallo zusammen,

ich habe folgendes Problem:
Ich habe mir meinen Code zusammengesucht/-gebaut, wenn ich diesen vor der Zeile

Code:

strSeite = objIE.Document.body.innerHTML 'Quellcode der Seite

stoppe und dann mit Einzelschritten (F8) weiter ausführe gibt mir die Funktion den entsprechenden Wert zurück. Beim "normalen" Durchlauf verändert sich der String des Quellcodes (oder wird abgeschnitten), sodass die folgenden Schritte nicht mehr funktionieren. Was kann ich hier machen?
Hier der Code:

Code:

Option Explicit
Private objIE As Object
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
        (ByRef lpdw As Long, ByVal dwReserved As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function GET_DISTANCE(Optional ByVal strStreetStart As String = "", _
    Optional ByVal strPlzStart As String = "", Optional ByVal strCityStart As String = "", _
    Optional ByVal strStreetEnd As String = "", Optional ByVal strPlzEnd As String = "", _
    Optional ByVal strCityEnd As String = "") As String
   
    Application.MacroOptions Macro:="MeineFunktion", Description:="Meine Beschreibung"
   
    Dim strUrl As String
    Dim booInetCon As Boolean
   
    ' Überprüfe, ob Internetverbindung besteht
    booInetCon = InternetGetConnectedState(0&, 0&)
    If booInetCon = False Then
        GET_DISTANCE = "#FEHLER"
        Exit Function
    End If

    ' Überprüfe, ob Start- oder Zielort Leerstrings sind
    If (strStreetStart & strPlzStart & strCityStart) = "" Or _
            (strStreetEnd & strPlzEnd & strCityEnd) = "" Then
        GET_DISTANCE = "#FEHLER"
        Exit Function
    End If

    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False

    strUrl = GenerateUrl(strStreetStart, strPlzStart, strCityStart, strStreetEnd, strPlzEnd,   _
_
strCityEnd)
    GET_DISTANCE = GatherDistance(strUrl)

    objIE.Quit
    Set objIE = Nothing
End Function


Private Function GenerateUrl(strStreetStart As String, strPlzStart As String, strCityStart As   _
_
String, _
        strStreetEnd As String, strPlzEnd As String, strCityEnd As String) As String
    Dim strStart
    Dim strEnd
   
    strStart = strStreetStart & ", " & strPlzStart & " " & strCityStart
    strEnd = strStreetEnd & ", " & strPlzEnd & " " & strCityEnd
GenerateUrl = "http://maps.google.com/maps?saddr=" & Trim(strStart) & "&daddr=" & Trim(strEnd) & _
_
"&hl=de"
    GenerateUrl = Replace(GenerateUrl, "ß", "%DF")
    GenerateUrl = Replace(GenerateUrl, "  ", "%20")
    GenerateUrl = Replace(GenerateUrl, " ", "%20")
    GenerateUrl = Replace(GenerateUrl, "ü", "%FC")
    GenerateUrl = Replace(GenerateUrl, "ä", "%E4")
    GenerateUrl = Replace(GenerateUrl, "ö", "%F6")
'     Debug.Print GenerateUrl
End Function

Private Function GatherDistance(strUrl As String) As String
    Dim i As Integer
    Dim lngStartPos As Long, lngEndPos As Long
    Dim strSeite As String

    objIE.Navigate strUrl
    For i = 1 To 20
        ' Mit Do: Loop Until objIE.Busy = False alleine kamen zu viele Fehler..., daher eine   _
_
For-Schleife mit Sleep():
        Sleep (100)
        Do: Loop Until objIE.Busy = False
        ' Debug.Print objIE.ReadyState
        ' Mit > 3 wäre man auf der sicheren Seite, allerdings dauert die Ausführung wesentlich  _
_
länger:
        If objIE.ReadyState > 2 Then
            Sleep (50)
            Exit For
        End If
    Next
    ' Siehe letzten Kommentar, hier müsste dann < 4 stehen
    ' Überprüfe, ob die Internetseite in der vorgegebenen Zeit fertig geladen wurde
    If objIE.ReadyState < 3 Then
        GatherDistance = "#FEHLER"
        Exit Function
    End If
    strSeite = objIE.Document.body.innerHTML 'Quellcode der Seite
    Debug.Print strSeite
    Debug.Print Len(strSeite)
    lngStartPos = InStr(1, strSeite, "438" & Chr(34) & Chr(62)) 'Chr(34) = """; Chr(62) = ">" - _
_
> Beispiel aus Quellcode: "
8,8 km
"
    lngEndPos = InStr(lngStartPos + 5, strSeite, Chr(38)) 'Chr(38) = "&"

      Debug.Print Mid(strSeite, lngEndPos + 6, 2)
'     Debug.Print Mid(strSeite, lngStartPos + 5, lngEndPos - lngStartPos - 5)
    ' Überprüfe, ob der Bereich, der scheinbar die Entfernung anzeigt, tatsächlich die  _
Entfernung anzeigt
    If StrComp(Mid(strSeite, lngEndPos + 6, 2), "km") <> 0 Then
        GatherDistance = "#FEHLER4"
        Exit Function
    End If
    GatherDistance = Mid(strSeite, lngStartPos + 5, lngEndPos - lngStartPos - 5)
    Debug.Print "Entfernung: " & GatherDistance
End Function

Danke für eure Hilfe und beste Grüße,
Benedikt

[schauan]

Hallo Benedikt,

meine erste Vermutung wäre ein Zeitproblem, aber Du setzt ja schon Sleep und anderes ein ein.

Andererseits hast Du einen Kommentar:
Mit > 3 wäre man auf der sicheren Seite, allerdings dauert die Ausführung wesentlich länger:
Bedeutet der, dass dann der Fehler nicht auftritt?


Hast Du mal noch den Aufruf zur Funktion damit man das mit der richtigen Seite testen kann?

[Bengo]

Hi,

ich hatte auch die Vermutung, dass es an der Zeit liegt und hatte nochmal ein Sleep eingebaut, aber ohne Erfolg.

Der Fehler liegt im letzten Teil. In der Beispieldatei ist zu sehen, dass mir immer der Fehlerwert #FEHLER4 ausgegeben wird, der aus der Prüfung, ob die KM-Entfernung im String steht, entsteht.
Der Teil des Seitenaufrufs von Google klappt ohne Probleme und benötigt keine weitere Zeit.

Vielleicht hat ja noch jemand eine Idee.



Danke & Gruß,
Benedikt

[chris-ka]

Hi,

http://www.clever-excel-forum.de/Thread-...-berechnen
Warum nicht gleich die distancematrix von Google verwenden :)

Da findest du zig Varianten.

lg

[Guschti]

Hallo Benedikt

Ich hab die "Sleep" bis 2000 erhöht, dann hat es geklappt.

Es gibt ja so viele Möglichkeiten dazu. Schon hier im Forrum
http://www.clever-excel-forum.de/Forum-K...tloesungen 

Oder meine Variante siehe Anhang:
Nachtrag: Nur Zellen A und B ausfüllen. Das Andere geht automatisch
Mfg Guschti