Inhalt aus Webseite - DHL Paket verfolgen

[Malte0691]

Guten Tag liebes Forum,

ich versuche bereits seit gestern verzweifelt auf eine Lösung zu kommen, wie ich in Excel das Zustelldatum mehrere DHL Sendungsnummern integrieren kann. Ich bin leider sehr unerfahren was VBA angeht und über den Menüpunkt "Daten abrufen"-"Aus dem Web" funktioniert es mit der Seite von DHL leider nicht.

Die Liste soll wie folgt aussehen
A1 "Sendungsnummer"
B1 "Zustelldatum"

Als Beispiel Sendungsnummer 00340434294387134797.

Der DHL Link baut sich immer gleich auf:
https://www.dhl.de/de/privatkunden/pakete-empfangen/verfolgen.html?idc="SENDUNGSNUMMER"
mit dieser Sendungsnummer also als Beispiel
https://www.dhl.de/de/privatkunden/paket...4387134797

Ich habe es schon mit Google Sheets probiert über XML Import, leider auch vergebens.

Vielleicht hat ja einer hier im Forum, die Erfahrung.
Ich würde mich wahnsinnig freuen.

Vielen Dank im Voraus und einen schönen Tag
Viele Grüße
Malte

*Frage ebenfalls gestellt im Herbers Excel Forum
https://www.herber.de/forum/messages/1725571.html

[steve1da]

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren gegenseitig?
Danke.

Gruß,
steve1da

[SteBen]

Hallo Malte,

versendest Du privat od. geschäftlich mit DHL?

Falls es geschäftlich ist, kannst Du Dir den Aufwand sparen, denn da stellt DHL eig. solche reports zur Verfügung bzw. Du kannst sie Dir selbst aus der shipping Software laden.

Nur so als Tipp  :19:

VG
SteBen

[Malte0691]

@steve1da erledigt :) 

@SteBen
Danke für die Antwort. Tatsächlich geschäftlich, doch leider wird bei dem Report nicht das Zustellungsdatum mit angegeben. Und es können leider nur 20 Sendungen gleichzeitig getracked werden, was für mein vorhaben leider bei weitem nicht ausreicht. 

Liebe Grüße

[SteBen]

Hi,

ich habe früher auch mal solche Reports bearbeitet, glaube die kamen vom Customer Service Team.
Je nach Sendungsvolumen sollten die Dir sowas eig. zur Verfügung stellen können.

Bzw. über Software wie Intraship o.ä. zum Download zur Verfügung stellen.

Vllt. fragst Du beim CS noch mal nach, andernfalls bleibt nur das basten :)

Viel Erfolg

VG
SteBen

[Malte0691]

Danke für deine Hilfe, doch leider sind diese Optionen keine Langfristige Lösung und auch nicht so einfach realisierbar. Ich muss also weiter tüfteln, dennoch vielen Dank! :)

[Zwenn]

Hallo Malte,

da die Diskussion in diesem Forum schon läuft, poste ich meine Anwort auch hier.

Du kannst den Zeitstempel mit folgendem Makro auslesen. Wenn Du es um eine Schleife und einem Zellbezug zu den Sendungsnummern erweiterst, kannst Du damit Deine Liste einfach durchgehen. Statt der Messagebox am Ende musst Du den geholten Wert natürlich in eine Tabelle schreiben.

Code:

Sub ZeitStempelDHL()

Const urlGrund As String = "https://www.dhl.de/de/privatkunden/pakete-empfangen/verfolgen.html?idc="
Dim urlSendungsNr As String
Dim url As String
Dim browser As Object
Dim knotenZeitStempel As Object
Dim zeitStempel As String

 'URL zusammensetzen
 'Die Sendungsnummer kann für jeden Abruf in
 'einer Schleife aus der Tabelle geholt werden
 urlSendungsNr = "00340434294387134797"
 url = urlGrund & urlSendungsNr
 
 'Internet Explorer initialisieren, Sichtbarkeit festlegen,
 'URL aufrufen und warten bis Seite vollständig geladen wurde
 Set browser = CreateObject("internetexplorer.application")
 browser.Visible = False
 browser.navigate url
 Do Until browser.ReadyState = 4: DoEvents: Loop
 
 'HTML-Element mit Zeitstempel holen
 Set knotenZeitStempel = browser.document.getElementsByClassName("mm_deliveryTime")(0)
 
 If Not knotenZeitStempel Is Nothing Then
   'Wenn das HTML-Element vorliegt
   'Zeitstempel aus HTML-Element extrahieren
   zeitStempel = Trim(knotenZeitStempel.innertext)
 Else
   zeitStempel = "Es wurde kein Zeitstempel gefunden"
 End If
 
 'Aufräumen
 browser.Quit
 Set browser = Nothing
 Set knotenZeitStempel = Nothing
 
 'Zeitstempel ausgeben
 MsgBox zeitStempel
End Sub

Viele Grüße,

Zwenn

[Malte0691]

Lieber Zwenn, 

ich danke dir erstmal sehr für deine Unterstützung.

Leider wird mir mit dem Code, wie er jetzt ist immer "Es wurde kein Zeitstempel gefunden" angezeigt.

Ich hoffe, ich werde jetzt nicht geprangert, aber verstehe es leider nicht wirklich. VBA ist wie gesagt gar nicht meins. Ich verstehe also jetzt nicht ganz, was ich an dem Code verändern soll. 

Ich habe als beispiel in Zeile A1-A500 meine Sendungsnummern, wie bekomme ich jetzt das Lieferdatum in die Zeile B1-B500. Entschuldige, wenn ich so doof nachfragen muss. 

Liebe Grüße
Malte

[Zwenn]

Hallo Malte,

nachfragen ist doch nicht dumm und dafür prangert Dich auch niemand an :19:

Starte das folgende Makro aus der Tabelle, in der Deine Sendungsnummern in Spalte A stehen. Das Makro geht durch so viele Zeilen, wie vorhanden sind. Ich würde vielleicht nicht gleich mit 500 Nummern starten Ich habe zusätzlich noch eine Pause von 2 Sekunden zu jedem Seitenaufruf eingebaut, damit die Seite auch zur Verfügung steht.

Code:

Sub ZeitStempelDHL()

Const urlGrund As String = "https://www.dhl.de/de/privatkunden/pakete-empfangen/verfolgen.html?idc="
Dim urlSendungsNr As String
Dim url As String
Dim browser As Object
Dim knotenZeitStempel As Object
Dim zeitStempel As String
Dim letzteZeile As Long
Dim aktuelleZeile As Long

 'Letzte Zeile in Spalte A in der Tabelle, aus der das Makro gestartet wird
 letzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 
 'Alle Sendungsnummern ab Zeile 1 Durchgehen
 For aktuelleZeile = 1 To letzteZeile
   'URL zusammensetzen
   'Die Sendungsnummer kann für jeden Abruf in
   'einer Schleife aus der Tabelle geholt werden
   urlSendungsNr = ActiveSheet.Cells(aktuelleZeile, 1).Value
   url = urlGrund & urlSendungsNr
   
   'Internet Explorer initialisieren, Sichtbarkeit festlegen,
   'URL aufrufen und warten bis Seite vollständig geladen wurde
   Set browser = CreateObject("internetexplorer.application")
   browser.Visible = False
   browser.navigate url
   Do Until browser.ReadyState = 4: DoEvents: Loop
   'Manuelle Pause, damit die Seite komplett zur Verfügung steht
   Application.Wait (Now + TimeSerial(0, 0, 2))
   
   'HTML-Element mit Zeitstempel holen
   Set knotenZeitStempel = browser.document.getElementsByClassName("mm_deliveryTime")(0)
   
   If Not knotenZeitStempel Is Nothing Then
     'Wenn das HTML-Element vorliegt
     'Zeitstempel aus HTML-Element extrahieren
     zeitStempel = Trim(knotenZeitStempel.innertext)
   Else
     zeitStempel = "Es wurde kein Zeitstempel gefunden"
   End If
   
   'Aufräumen
   browser.Quit
   Set browser = Nothing
   Set knotenZeitStempel = Nothing
   
   'Zeitstempel eintragen
   ActiveSheet.Cells(aktuelleZeile, 2).Value = zeitStempel
 Next aktuelleZeile
End Sub

Viele Grüße,

Zwenn

[Malte0691]

Zwenn, du bist der Hammer!!!

Ich bin dir sehr sehr dankbar! Ich würde 1000 mal "danke" klicken, wenn es ginge. Das war ein verfrühtes Weihnachtsgeschenk von dir! 

Vielen Dank und beste Grüße
Malte