Google Earth mit VBA ansteuern

Private Sub cmdHoehe_Click()
    'ruft Google-Earth auf
    SchneeGE "Kolonnenstr. 30 L, 10829 Berlin" '[Strasse Nr, PLZ ]Ort
End Sub

Private Sub SchneeGE(Optional ByVal strOrt As String)

'Ruft Google Earth auf und listet strOrt im Suchbereich
' VBA-Entwicklungsumgebung (VDE), Menü Extras - Verweise - "Earth 1.0 Type Library" zuschalten!
' siehe auch: Google Earth ferngesteuert
' ACHTUNG: Es erfolgt keine Prüfung oder Fehlerbehandlung, falls GE nicht installiert ist. In
' der Ur-Fassung wird DIESE Sub über einen Button aus Excel heraus gestartet, der Aufruf über
' eine andere Routine o. ä. lässt sich flexibel gestalten.
'
' Ein aktiver Internetzugang und eine vorhandene "Google Earth"-Installation werden vorausgesetzt.

Dim objGE As Object     'die Anwendung Google Earth (GE)
Dim objSC As Object     'SearchControllerGE (Suchfeld von GE)
Dim objFC As Object     'Suchergebnisse
Dim i As Integer
'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
Dim dblAPo As Double    'Wert der in GE eingestellten Anflug-Geschwindigkeit des AutoPiloten

    Set objGE = CreateObject("GoogleEarth.ApplicationGE")
         
    With objGE
    Do                                  'Prüfen, ob GE geöffnet, verfügbar, online, nicht busy
        DoEvents                        ' .isonline beim Testen Offline auskommentieren!
    Loop Until .IsInitialized = 1 And .IsOnline = 1 And .SearchController.IsSearchInProgress = 0
    End With

    'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
    dblAPo = objGE.AutoPilotSpeed       'Original-Anfluggeschwindigkeit auslesen
    objGE.AutoPilotSpeed = 5            'überschreiben: 5 = Maximum!
   
    Set objSC = CreateObject("GoogleEarth.SearchcontrollerGE")
    objSC.ClearResults                  'Verklauf leeren
    Application.Wait (Now + TimeValue("0:00:01")) 'Verzögerung erzwingt anfliegen?!
    'steuert Anfluggeschwindigkeit - Reihenfolge NICHT verändern: AutoPilot --> Search
    objSC.Search strOrt
    Do
        DoEvents
    Loop Until objSC.IsSearchInProgress = 0
   
    Set objFC = objSC.GetResults        'Suchergebnisse von GE abfragen
    If objFC.Count > 0 Then             'Falls mehrere Treffer: Auflisten
        If InStr(1, objFC(1).Name, "Meinten Sie") <> 0 Then
            Set objFC = objFC(1).GetChildren
            For i = 1 To objFC.Count
                Debug.Print objFC(i).Name
            Next i
            strOrt = Chr$(objFC.Count) & "Nicht eindeutig"
        Else                            'Falls EIN Treffer: Anzeigen
            strOrt = objFC(1).Name
            objFC.Item(1).Highlight
        End If
    End If

    'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
    objGE.AutoPilotSpeed = dblAPo       'Original-Anfluggeschwindigkeit wiederherstellen
   
    Set objGE = Nothing                 'Speicherplatz freigeben
    Set objSC = Nothing

End Sub