Option Compare Database
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, _
  ByRef strAccuracy 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 = True
    ' URL aufrufen
    ' Google-Maps im XML Format
    .Navigate "http://maps.google.com/maps/geo?q=" & strOrtPLZ & "%20" & _
      strStrasse & "%20" & strLand & "&output=xml&sensor=false&key=abcdefg"
 
 
 
    ' 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)
 
    ' Accuracy
   [u] ExtractData strArr(i), "Accuracy", strAccuracy   
 
    ' 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
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