Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE | VB-Versionen: VB6 | 12.04.10 |
Informationen eines bestimmten Ortes ermitteln Diese Funktion ermittelt unter Zuhilfenahme von GoogleMaps Informationen eines bestimmten Ortes. | ||
Autor: Dennis Hemken | Bewertung: | Views: 10.796 |
gadgets.hemken.org | System: Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Mit Hilfe nachfolgender Funktion lassen sich, neben den Koordinaten auch weitere Informationen eines bestimmten Ortes anhand einer Postleitzahl, oder eines Ortsnamen und einer Strasse bestimmen. Bei dem Tipp Koordinaten eines bestimmten Ortes ermitteln ging es nur um die Koordinaten. Der Aufruf der Google Maps URL, in der Funktion getCoordinatesCSV, mit dem Attribut &output=csv enthält lediglich die Koordinaten des zu bestimmenden Ortes. Wobei der Aufruf der Google Maps URL, in der Funktion getCoordinatesXML_AndMore, mit dem Attribut &output=xml neben den Koordinaten noch weitere Informationen bereitstellt. Neben coordinates gibt es noch:
- address
- CountryNameCode
- CountryName
- AdministrativeAreaName
- SubAdministrativeAreaName
- LocalityName
- DependentLocalityName
- ThoroughfareName
- PostalCodeNumber
Public Function getCoordinatesXML_AndMore(ByVal strOrtPLZ As String, _ ByVal strStrasse As String, _ ByRef strCoordinates As String, _ ByRef strCountryNameCode As String, _ ByRef strCountryName As String, _ ByRef strAdministrativeAreaName As String, _ ByRef strSubAdministrativeAreaName As String, _ ByRef strLocalityName As String, _ ByRef strDependentLocalityName As String, _ ByRef strThoroughfareName As String, _ ByRef strPostalCodeNumber As String, _ Optional strLand As String = "Deutschland") Dim IEApp As Object Dim IEDocument As Object Dim strArr As Variant Dim i As Long ' IE-Instanz erstellen Set IEApp = CreateObject("InternetExplorer.Application") With IEApp ' IE-Fenster unsichtbar lassen .Visible = False ' URL aufrufen ' Google-Maps im XML Format .Navigate "http://maps.google.com/maps/geo?q=" & strOrtPLZ & "%20" & _ strStrasse & "%20" & strLand & "&output=xml" ' Warten, bis Seite geladen Do: Loop Until .Busy = False Do: Loop Until .Busy = False While IEApp.Busy: Wend ' IE-Dokument Set IEDocument = .Document End With Do DoEvents Loop Until IEDocument.readyState <> 4 ' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten strArr = Split(IEDocument.Body.innerText, vbCrLf) For i = LBound(strArr) To UBound(strArr) ' Landcode ExtractData strArr(i), "CountryNameCode", strCountryName ' Land ExtractData strArr(i), "CountryName", strCountryName ' Bundesland ExtractData strArr(i), "AdministrativeAreaName", strAdministrativeAreaName ' Bundesland Sub ExtractData strArr(i), "SubAdministrativeAreaName", strSubAdministrativeAreaName ' Ort ExtractData strArr(i), "LocalityName", strLocalityName ' Ortsteil ExtractData strArr(i), "DependentLocalityName", strDependentLocalityName ' Strasse ExtractData strArr(i), "ThoroughfareName", strThoroughfareName ' PLZ ExtractData strArr(i), "PostalCodeNumber", strPostalCodeNumber ' Koordinaten ExtractData strArr(i), "coordinates", strCoordinates Next i IEApp.Quit ' Objekte zerstören Set IEDocument = Nothing Set IEApp = Nothing End Function
' Hilfsfunktion Private Sub ExtractData(ByVal sData As String, ByVal sTag As String, ByRef sResult As String) If InStr(1, sData, "</" & sTag & ">", vbTextCompare) > 0 Then sResult = Trim$(Replace(sData, "</" & sTag & ">", "")) sResult = Trim$(Replace(sResult, "<" & sTag & ">", "")) End If End Sub
Aufrufbeispiel:
Dim strOrtPLZ As String Dim strStrasse As String Dim strCoordinates As String Dim strCountryNameCode As String Dim strCountryName As String Dim strAdministrativeAreaName As String Dim strSubAdministrativeAreaName As String Dim strLocalityName As String Dim strDependentLocalityName As String Dim strThoroughfareName As String Dim strPostalCodeNumber As String strOrtPLZ = "97708" strStrasse = "Maria-Stern-Str. 20" Call getCoordinatesXML_AndMore(strOrtPLZ, strStrasse, _ strCoordinates, strCountryNameCode, strCountryName, _ strAdministrativeAreaName, strSubAdministrativeAreaName, _ strLocalityName, strDependentLocalityName, _ strThoroughfareName, strPostalCodeNumber) Debug.Print strOrtPLZ & vbCrLf & strStrasse & vbCrLf & strCoordinates & vbCrLf & _ strCountryNameCode & vbCrLf & strCountryName & vbCrLf & _ strAdministrativeAreaName & vbCrLf & strSubAdministrativeAreaName & vbCrLf & _ strLocalityName & vbCrLf & strDependentLocalityName & vbCrLf & _ strThoroughfareName & vbCrLf & strPostalCodeNumber