Mit Schleife Internetseite öffnen und kopieren
15.03.2018 14:59:09
Patrick
Unsere Firma bietet sogenanntes Valet- Parking an. Das heisst, der Kunde kann, nach der Reservation, sein Fahrzeug am Flughafen abgeben und bei der Rückkehr wieder dort abholen. Er kann verschiedene verschiedene Dienstleistungen buchen: Parkplatz im Freien, im Parkhaus und zudem kann er das Fahrzeug auch noch waschen lassen. Je nachdem wird das Fahrzeug von unseren Fahrern an einen anderen Standort gefahren.
Damit wir nun unsere Parkplatzbelegung besser planen und auch das Personal welches die Fahrzeuge wäscht, optimal einteilen können, möchten wir nun die Daten aus der Internetseite ins Excel kopieren.
Dies für einen Tag zu machen habe ich mit folgendem VBA- Code bereits geschafft:
Sub PrintAnsichtÖffnen()
'Tip: HTML-Codes mit FireFox auslesen
'("Links Klick" und Element untersuchen)
'Seite wird markiert, kopiert und auf Arbeitsblatt eingefügt
'InternetExplorer wird geschlossen
Dim IEApp As Object
Dim IEDoc As Object
Dim objCtrl As Object
'InternetExplorer -> Internetseite öffnen
Set IEApp = CreateObject("InternetExplorer.Application")
'Bildschirmaktualisierung ausschalten
'Application.ScreenUpdating = False
'InternetExplorer sichtbar = True, nicht sichtbar = False
IEApp.Visible = False
IEApp.Navigate "https://www.aaa.bb/admin/login.php"
'Warten bis Seite geladen ist
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
With IEApp.document
Do: Loop Until .ReadyState = "complete"
Set IEDoc = IEApp.document
'Benutzername und Passwort eintragen (HTML-Code auslesen für ID)
.getelementbyid("user").Value = "XXX" 'anpassen
.getelementbyid("passwort").Value = "YYY" 'anpassen
'OK-Knopf hat keine ID (HTML-Code auslesen, "Type" und "Value" ermitteln)
For Each objCtrl In IEApp.document.forms(0).elements
If objCtrl.Type = "submit" Then
If objCtrl.Value = "Login" Then
objCtrl.Click
Exit For
End If
End If
Next
End With
' Warten bis Seite geladen ist
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
With IEApp.document
Do: Loop Until .ReadyState = "complete"
'Datum eintragen (HTML-Code auslesen für ID, Format ermitteln)
'(In diesem Fall muss es Text sein)
.getelementbyid("datesearch").Value = Tabelle1.Name 'anpassen
'Search-Knopf hat keine ID (HTML-Code auslesen, "Type" und "Value" ermitteln)
For Each objCtrl In IEApp.document.forms(0).elements
If objCtrl.Type = "submit" Then
If objCtrl.Value = "Suche" Then
objCtrl.Click
Exit For
End If
End If
Next
End With
'Warten bis Seite geladen ist
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
With IEApp.document
Do: Loop Until .ReadyState = "complete"
'Zu Internetseite für Print-Ansicht navigieren (HTML-Code auslesen)
IEApp.Navigate "https://www.aaa.bb/admin/print.php"
'Warten bis Seite geladen ist
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
With IEApp.document
Do: Loop Until .ReadyState = "complete"
'Seite markieren...
IEApp.ExecWB 17, 2, 0, 0
'...kopieren...
IEApp.ExecWB 12, 2, 0, 0
'Einfügebereich auswählen
Application.Goto reference:=Tabelle1.Cells(1, 1), Scroll:=False
'...einfügen
Tabelle1.Paste
'Zwischenablage leeren, Kopierbereich entfernen
Application.CutCopyMode = False
End With
End With
IEApp.Quit
Set IEDoc = Nothing
Set IEApp = Nothing
Set objCtrl = Nothing
' Application.ScreenUpdating = True
End Sub
Mein Ziel wäre nun, mittels einer Schleife, dies für mehrere Tage zu machen.
Die Codenamen der Arbeitsblätter sind Tabelle1, Tabelle2, u.s.w. bis Tabelle11. Die Register werden dynamisch mit dem jeweiligen Datum (heutiges Datum - 4 bis heutiges Datum + 6) beschriftet. Dies um am Montag zu Überprüfen, ob übers Wochenende alle Kunden tatsächlich gekommen sind oder ob es noch spontan Buchungen gegeben hat u.s.w. um dies in Zukunft eventuell auch noch berücksichtigen zu können.
Ich habe wieder mal eine Menge gegoogelt und ausprobiert, aber es gelingt mir nicht.
Ich habe den obenstehenden Code erweitert, bekomme jedoch immer die Fehlermeldung "Next ohne For" und ich kriege nicht heraus warum (zur besseren Übersicht, habe ich die Änderungen fett formatiert):
Sub MehrereDatenAusWeb()Ich bin mir sicher, dass hier ein Profi im Forum ist, der sieht, wo der Fehler liegt.
Freundliche Grüsse aus der Schweiz
Patrick Zaugg
