Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1640to1644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hilfe mit VBA Code - Entfernungen nach PLZ

Hilfe mit VBA Code - Entfernungen nach PLZ
22.08.2018 15:03:14
BG
Hallo zusammen,
ich habe folgendes Problem:
Ich habe mir meinen Code zusammengesucht/-gebaut, wenn ich diesen vor der Zeile

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:

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 " - _
_
> 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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe mit VBA Code - Entfernungen nach PLZ
26.08.2018 11:36:28
fcs
Hallo Benedikt,
die von dir eingebaute For-Next-Schleife mit Wartezeiten funktioniert so nicht, da der ReadStatus des IE schon den Wert 3 oder 4 liefert und somit die Schleife schon im 1. Durchlauf verlassen wird.
Diese Extra-Zeit reicht noch nicht, um die Google-Maps-Seite komplett aufzubauen inkl. der Routenberechnung.
Ich hab es jetzt so geändert, dass die Schleife verlassen wird, wenn im Quell-Code der Seite der Text " km&st" vorhanden ist.
Auch das Ermitteln der Entfernung aus dem Quelltext musste ich umstellen, da bei mir im Quelltext die Ziffernfolge "438" vor dem km-Wert nicht auftaucht.
Gruß
Franz
Text-Datei mit angepasstem Code:
https://www.herber.de/bbs/user/123561.txt
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige