Function RueckwaertssucheDasOertliche(ByVal Ruf_NR As String)
Dim myurl, Anrufer, Adresse As String
Dim oIE As Variant
Dim Oertliche_HTML As String
If Left(Ruf_NR, 2) = "49" Then Ruf_NR = "0" & Right(Ruf_NR, Len(Ruf_NR) - 2)
If Left(Ruf_NR, 3) = "+49" Then Ruf_NR = "0" & Right(Ruf_NR, Len(Ruf_NR) - 3)
'URL-Pfad
myurl = "http://www2.dasoertliche.de/?form_name=search_inv&page=RUECKSUCHE&context=RUECKSUCHE&action=STANDARDSUCHE&la=de&rci=no&ph=" & Ruf_NR
'Falls ein HTML-Error kommt, bzw. kein User gefunden wurde, dann "Unbekannter Teilnehmer"
On Error GoTo KeineRuecksuche
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate myurl
Sleep 300 'Dreihundert Millisekunden
While Not oIE.ReadyState = 4
DoEvents 'Gibt Kontrolle für neues Scheduling an MS Windows zurück
Sleep 100 'Hundert Millisekunden warten
Wend
'HTML-Code an Variable
Oertliche_HTML = oIE.document.Body.InnerHtml
Dim Pos As Long
'HTML-Code hinter dem Namen
Pos = InStr(1, Oertliche_HTML, "</A> <SPAN style=", vbTextCompare)
Anrufer = Left(Oertliche_HTML, Pos - 1)
'alles vor dem Namen löschen
Pos = 1
Do While Pos <> 0
Pos = 1
Pos = InStr(Pos, Anrufer, ">", vbTextCompare)
Anrufer = Right(Anrufer, Len(Anrufer) - Pos)
Loop
'Adresse ermitteln
Oertliche_HTML = Right(Oertliche_HTML, Len(Oertliche_HTML) - Pos)
Pos = InStr(1, Oertliche_HTML, "<BR><INPUT type=hidden", vbTextCompare)
Adresse = Left(Oertliche_HTML, Pos - 1)
Oertliche_HTML = Right(Oertliche_HTML, Len(Oertliche_HTML) - Pos)
'alles vor der Adresse löschen
Pos = 1
Do While Pos <> 0
Pos = 1
Pos = InStr(Pos, Adresse, ">", vbTextCompare)
Adresse = Right(Adresse, Len(Adresse) - Pos)
Loop
' ersetzen
Adresse = Replace$(Adresse, " ", " ", , , vbTextCompare)
'Name und Adresse werden in einem String übergeben
RueckwaertssucheDasOertliche = Anrufer & ";" & Adresse
Exit Function
KeineRuecksuche:
RueckwaertssucheDasOertliche = "Unbekannter Teilnehmer"
End Function