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:
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 Dieser Tipp wurde bereits 10.798 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |