Web-Formular ausfüllen und abfragen

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim IEApp As Object, IEDocument As Object
Dim objWMIService As Object, colItems As Object, objItem As Object
Dim fensterhoehe As Integer, fensterbreite As Integer
If Target.Column > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DisplayConfiguration", , 48)
For Each objItem In colItems
fensterhoehe = objItem.PelsHeight
fensterbreite = objItem.PelsWidth
Next
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
.Navigate ("http://www.swift.com/bsl/freequery.do")
.Visible = True
.Width = fensterbreite
.Height = fensterhoehe
.Left = 0
.Top = 0
End With
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
Do
Loop Until IEDocument.ReadyState  4
IEDocument.getElementById("selected_bic").Value = Target.Value
Application.Wait (Now + TimeValue("0:00:01"))
IEDocument.frmFreeSearch1.submit
Set IEDocument = Nothing
Set IEApp = Nothing
Set objWMIService = Nothing
Set colItems = Nothing
Cancel = True
End Sub