Internetexplorer Formular ausfüllen Button klicken

Frage: Wie kann man eigentlich im Internetexplorer ein Suchformular ausfüllen und anschließend auf einen Button klicken? Das untere Beispiel funktioniert natürlich nur solange, bis der Homepagebetreiber entsprechende Änderungen an seiner Seite vornimmt. :-)

Option Explicit
' strURL anpassen!!!
Const strURL As String = "http://www.vaillant.de"
Public Sub Test()
    Dim objIEDoc As Object
    Dim objIE As Object
    On Error GoTo Fin
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .Navigate2 strURL
        Do While .ReadyState <> 4: DoEvents: Loop
        Do While .Busy = True: DoEvents: Loop
        With .Document.Forms(0)
            .Elements("search_query").Value = _
                "Pellet-Heizkessel renerVIT VKP"
            .Elements("search_button").Click
        End With
        Do While .ReadyState <> 4: DoEvents: Loop
        Do While .Busy = True: DoEvents: Loop
        Set objIEDoc = .Document
    End With
    Do: Loop Until objIEDoc.ReadyState <> 4
    Debug.Print objIEDoc.Images.Item(1).Src
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
    If Not objIE Is Nothing Then objIE.Quit
    Set objIEDoc = Nothing
    Set objIE = Nothing
End Sub
Public Sub Test_1()
    Dim objIEDoc As Object
    Dim objIE As Object
    On Error GoTo Fin
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = True
        .Navigate2 _
            "http://www.vaillant.de/Suche/?suchen_nach=Pellet-Heizkessel+renerVIT+VKP"
        Do While .ReadyState <> 4: DoEvents: Loop
        Do While .Busy = True: DoEvents: Loop
        Set objIEDoc = .Document
    End With
    Do: Loop Until objIEDoc.ReadyState <> 4
    Debug.Print objIEDoc.Images.Item(1).Src
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
    If Not objIE Is Nothing Then objIE.Quit
    Set objIEDoc = Nothing
    Set objIE = Nothing
End Sub

Und noch ein Beispiel für die Google-Suche. Hier wird noch gezeigt, wie auf eine laufende Internetexplorerinstanz zugegriffen werden kann und wie das Fenster maximiert wird:

Option Explicit
Private Declare Sub ShowWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal nCmdShow As Long)
Const strTMP As String = "Excel VBA"
Private Const SW_MAXIMIZE = 3
Public Sub Test()
    Dim objWindow As Object
    Dim objIEApp As Object
    Dim objShell As Object
    Dim objItem As Object
    On Error GoTo Fin
    Set objShell = CreateObject("Shell.Application")
    Set objWindow = objShell.Windows()
    For Each objItem In objWindow
        If LCase(objItem.FullName Like "*iexplore*") Then
            Set objIEApp = objItem
        End If
    Next objItem
    If objIEApp Is Nothing Then
        Set objIEApp = CreateObject("InternetExplorer.Application")
        objIEApp.Visible = True
    End If
    With objIEApp
        .Visible = True
        ShowWindow .hWnd, SW_MAXIMIZE
        .Navigate "http://www.google.de"
        While Not .ReadyState = 4
            DoEvents
        Wend
        .Document.all.q.Value = strTMP
        .Document.Forms(0).submit
    End With
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
    Set objWindow = Nothing
    Set objShell = Nothing
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...