AW: prüfen ob IE-Seite offen
11.09.2009 13:37:10
Werner
Ich habe mich zu früh gefreut!
Der Code läuft, solange kein IE offen ist.
Ansonsten kommt bei der Zeile
If win.Document.Location = adresse Then
die Meldung "Laufzeitfehler 70 - Zugriff verweigert"
Hier der gesamte Code:
Sub Strehlow_Lagerliste()
'Dim liDurchlauf As Integer
Dim WshShell As Object
Dim objShell As Object
Dim IEApp As Object, win As Object
Dim adresse As String, gefunden As Boolean
gefunden = False
adresse = "https://secure.strehlow.info" 'anpassen
Set objShell = CreateObject("Shell.Application")
For Each win In objShell.Windows
If win.Document.Location = adresse Then
gefunden = True
AppActivate win.Document.Title & " - Win"
End If
Next
If gefunden = False Then
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = True
IEApp.Navigate adresse
Set IEApp = Nothing
Set WshShell = CreateObject("WScript.Shell")
Application.Wait TimeSerial(Hour(Now()), _
Minute(Now()), Second(Now()) + 3)
'WshShell.SendKeys "j"
' Application.Wait TimeSerial(Hour(Now()), _
Minute(Now()), Second(Now()) + 1)
'WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys Range("L1")
WshShell.SendKeys "{TAB}"
WshShell.SendKeys Range("N1")
WshShell.SendKeys "{ENTER}"
Application.Wait TimeSerial(Hour(Now()), _
Minute(Now()), Second(Now()) + 1)
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{TAB}"
WshShell.SendKeys "{ENTER}"
Application.Wait TimeSerial(Hour(Now()), _
Minute(Now()), Second(Now()) + 1)
WshShell.SendKeys "^(f)"
End If
Set objShell = Nothing
End Sub
Gruß und Danke!
Werner