vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE   |   VB-Versionen: VB612.04.10
Informationen eines bestimmten Ortes ermitteln

Diese Funktion ermittelt unter Zuhilfenahme von GoogleMaps Informationen eines bestimmten Ortes.

Autor:   Dennis HemkenBewertung:     [ Jetzt bewerten ]Views:  10.796 
gadgets.hemken.orgSystem:  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

Dieser Tipp wurde bereits 10.796 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!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.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel