AW: Trainings Details von GLS in Excel
29.05.2020 15:02:18
GLS
Hallo Neuling,
es geht nur über den Internet Explorer. Habe Dir mal was zusammengestrickt:
Sub GlsTracking()
'Das Makro arbeitet auf der Tabelle, aus der es gestartet wird
'Die Tracking Nummern werden in Spalte A ab Zeile 2 erwartet
'Die Statustexte werden in Spalte B hinter die Nr. geschrieben
Const url As String = "https://www.gls-pakete.de/sendungsverfolgung"
Dim browser As Object
Dim nodeSearchField As Object
Dim nodeSearchButton As Object
Dim nodeStatusText As Object
Dim trackingNumber As String
Dim currentRow As Long
Dim check As Boolean
currentRow = 2 'Startzeile mit erster Trackingnummer
'Schleife zum abarbeiten aller Trackingnumern
Do Until ActiveSheet.Cells(currentRow, 1).Value = ""
'Trackingnummer aus Tabelle lesen
trackingNumber = ActiveSheet.Cells(currentRow, 1).Value
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
'Textfeld für die Trackingnummer
On Error Resume Next
Set nodeSearchField = browser.document.getElementByID("trackandtrace__searchinput")
On Error GoTo 0
'Wenn Textfeld vorhanden, Trackingnummer eintragen
If Not nodeSearchField Is Nothing Then
nodeSearchField.Value = trackingNumber
check = True
Else
check = False
End If
'Submit Button
On Error Resume Next
Set nodeSearchButton = browser.document.getElementByID("trackandtrace__searchbutton")
On Error GoTo 0
'Wenn Submit Button vorhanden, klicken
If Not nodeSearchButton Is Nothing Then
nodeSearchButton.Click
'Pause zum laden der Folgeseite
'Die drei hinteren Werte sind Stunden, Minuten, Sekunden
Application.Wait (Now + TimeSerial(0, 0, 3))
check = True
Else
check = False
End If
'Statustext der Sendung auslesen
Set nodeStatusText = browser.document.getElementsByClassName("text-primary lead")(1)
'Statustext in Tabelle schreiben, wenn gefunden
If Not nodeStatusText Is Nothing Then
ActiveSheet.Cells(currentRow, 2).Value = Trim(nodeStatusText.innertext)
Else
ActiveSheet.Cells(currentRow, 2).Value = "Kein Statustext gefunden. Nr. evtl. ungültig"
End If
'Für nächste Trackingnummer vorbereiten
currentRow = currentRow + 1
check = False
browser.Quit
Set browser = Nothing
Set nodeSearchField = Nothing
Set nodeSearchButton = Nothing
Loop
End Sub
Viele Grüße,
Zwenn