Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1644to1648
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

zum Thema UPS-Tracking

zum Thema UPS-Tracking
17.09.2018 10:18:40
Reinhard
Hallo zusammen,
das eigentliche Thema ist bereits im Archiv: https://www.herber.de/cgi-bin/callthread.pl?index=1620005#1620005
Nun scheint UPS etwas geändert zu haben, ich komme momentan aber nicht drauf was es sein soll. Die Abfrage funktioniert nicht mehr mit dem Hinweis, dass ein Objekt erforderlich sei. Die Meldung kam in der Vergangenheit, wenn entweder die ID zu schnell abgefragt wurde (UPS diese also noch nicht kannte), oder UPS ein internes Problem hatte.
Hier der Code, der bislang sehr gut funktionierte:

'UPS-Abfrage - START
Dim trackingNumber As String, trackingURL As String
Dim trackingCode As Variant
Dim IEexp As InternetExplorer: Set IEexp = New InternetExplorer
Dim lastRow As Long, i As Long
lastRow = Tabelle1.Cells(Rows.Count, "L").End(xlUp).Row
For i = 2 To lastRow
If Tabelle1.Cells(i, "M").Value  "Zugestellt" Then
trackingNumber = Tabelle1.Cells(i, "L").Value
trackingURL = "http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=de_DE& _
_
_
_Requester=UPSHome&tracknum=" & trackingNumber & "&AgreeToTermsAndConditions=yes&ignore=&track.  _
_
x=25&track.y=16"
IEexp.Visible = False
IEexp.Navigate trackingURL
Do While IEexp.readyState  4: DoEvents: Loop
Dim inputElement As Object
Set inputElement = IEexp.Document.getElementById("tt_spStatus")
If (Not inputElement Is Nothing) Then
Tabelle1.Cells(i, "M").Value = Trim(inputElement.innerText)
Else
Tabelle1.Cells(i, "M").Value = "Fehler"
End If
End If
Next
IEexp.Quit
Set IEexp = Nothing
'UPS-Abfrage - ENDE

Eine Manuelle Abfrage mit dem Link http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=de_DE&_Requester=UPSHome&tracknum=
und der TrackingID funktioniert allerdings noch tadellos. Evtl. kennt einer von Euch ja die "Fehlerquelle" bei UPS bzw. hat nen Tip was man ändern müsste dass es wieder funktioniert.
Danke und Gruß
Reinhard

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zum Thema UPS-Tracking
17.09.2018 10:43:57
Reinhard
Ich hab eben herausgefunden, dass das Layout und der Code auf der UPS-Seite geändert wurde. Hier bräuchte ich nun leider eure Hilfe, da ich nicht weiterkomme.
Der Abgriff bzgl. des Status hat sich geändert, vorher funktionierte das mit
Set inputElement = IEexp.Document.getElementById("tt_spStatus")
Nun gibt es auf der UPS-Seite kein tt_spStatus mehr. Ich bin mir nun nicht Sicher, ob der Neue nun stApp_txtPackageStatus ist, oder gar ein Anderer.
Hiiiilfeeeee :-D
Grüße
Reinhard
AW: zum Thema UPS-Tracking
17.09.2018 11:30:11
PeterK
Hallo
Ohne gültige Trackingnummer kann ich leider nicht weiterhelfen
Anzeige
AW: zum Thema UPS-Tracking
17.09.2018 12:10:31
Reinhard
Sorry, hatte ich glatt vergessen. Hier eine Beispiel TrackingID 1Z86W3666898996048
AW: zum Thema UPS-Tracking
17.09.2018 14:24:14
PeterK
Hallo
Wenn Du die Meldung "Lieferung bereit für UPS" (Status deiner Trackingnummer) dann stimmt IEexp.document.getElementById("stApp_txtPackageStatus").Innertext
AW: zum Thema UPS-Tracking
17.09.2018 15:03:53
Reinhard

Set inputElement = IEexp.Document.getElementById("stApp_txtPackageStatus") 'IEexp. _
Document.getElementById("tt_spStatus")
If (Not inputElement Is Nothing) Then
Tabelle1.Cells(i, "M").Value = Trim(inputElement.Innertext)
Funktioniert leider auch nicht. Ich vermute, der ganze Code muss umgeschrieben werden.
Wie gesagt, der bisherige hatte bis Freitag letzter Woche wunderbar funktioniert:
Sub checkUPS() 'UPS-Abfrage und Zellen der Netto-Arbeitstage einfärben
'############################################################################################### _
UserForm1.Show vbModeless 'UserForm bzw. Hinweisfenster einblenden
'############################################################################################### _
'UPS-Abfrage - START
Dim trackingNumber As String, trackingURL As String
Dim trackingCode As Variant
Dim IEexp As InternetExplorer: Set IEexp = New InternetExplorer
Dim lastRow As Long, i As Long
lastRow = Tabelle1.Cells(Rows.Count, "L").End(xlUp).Row
For i = 2 To lastRow
If Tabelle1.Cells(i, "M").Value  "Zugestellt" Then
trackingNumber = Tabelle1.Cells(i, "L").Value
trackingURL = "http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=de_DE& _
_Requester=UPSHome&tracknum=" & trackingNumber & "&AgreeToTermsAndConditions=yes&ignore=&track.x=25&track.y=16"
IEexp.Visible = False
IEexp.Navigate trackingURL
Do While IEexp.readyState  4: DoEvents: Loop
Dim inputElement As Object
Set inputElement = IEexp.Document.getElementById("tt_spStatus")
If (Not inputElement Is Nothing) Then
Tabelle1.Cells(i, "M").Value = Trim(inputElement.Innertext)
Else
Tabelle1.Cells(i, "M").Value = "Fehler"
End If
End If
Next
IEexp.Quit
Set IEexp = Nothing
'UPS-Abfrage - ENDE

Anzeige
Ich fürchte das geht gar nicht mehr
17.09.2018 15:25:38
Zwenn
Hallo Reinhard,
ich weiß zwar nicht, wie die Seite vorher aussah, aber jetzt wird sie über "wilde Webtechniken" generiert. Wenn man versucht irgend etwas aus dem ganzen weißen Bereich der Seite im Quelltext zu finden, scheitert man. Es ist scheinbar nicht vorhanden. Analysiert man den Seitenquelltext dann, findet man jede Menge Quellcode zum Header und zum Footer. Der gesamte Mittelteil hingegen ist sehr kurz und wird in folgende beide HTML-Kommentare eingeschlossen:

<!-- begin body wrapper -->
etwas HTML, unter anderem mit folgendem Tag
<app-root
stApp_locale=de_DE
stApp_clientmapKey=ArLnEIjcDlh0S0C8WC-BO95tEcxGiTmXGBi1kjAjBZn8Q7Q0Hv8scCmtVnL_xORR
isUserLoggedIn=False
isLoggedInAvailable=True
loginSignupReturnToLink=https%3A%2F%2Fwww.ups.com%2Ftrack%3Floc%3Dde_DE%2Fredirect
myChSignupLink=/doapp/SignUpMyChoice?loc=de_DE&returnto=https%3A%2F%2Fwww.ups.com
%2Ftrack%3Floc%3Dde_DE%2Fredirect
qvmLink=//www.ups.com/content/de/de/tracking/quantumview/index.html
flexLink=//www.ups.com/content/de/de/tracking/fgv/index.html
userEmail=>
<!-- end body wrapper -->
Sieht also so aus, als sei die eigentliche Information, an die Du ran willst "eingewickelt" (wrapped). Ich zumindest habe keine Ahnung, wie man an den Inhalt ran kommen kann.
Viele Grüße,
Zwenn
Anzeige
Sorry, hatte einen Denkfehler
17.09.2018 16:06:56
Zwenn
Hallo noch einmal,
man kommt natürlich doch an den Wert dran. Mir war nur der Fehler unterlaufen, vom einzusehenden Seitenquelltext auszugehen. Wenn man mit Strg + A die Seite markiert und sich dann den ausgewählten Seitenquelltext anzeigen lässt, dann sieht man auch, nach was man sucht.
Du hattest schon die richtige Stelle am Wickel, wie Peter ja auch bereits bestätigte. Da es sich aber um einen nachgeladenen Inhalt handelt, reicht es nicht aus zu warten, bis der Browser das erste mal meldet, dass er die Seite ganz geladen hat. Man muss zusätzlich einen Wartebefehl einbauen. Ich habe die Wartezeit auf 5 Sekunden gesetzt. Bei mir liest er den gesuchten Wert damit klaglos aus. Du musst ausprobieren, ob 5 Sekunden für Dich ok sind und ggf. anpassen.

Dim trackingNumber As String
Dim trackingURL As String
Dim trackingCode As Variant
Dim IEexp As Object
Dim inputElement As Object
Dim lastRow As Long, i As Long
lastRow = Tabelle1.Cells(Rows.Count, "L").End(xlUp).Row
Set IEexp = CreateObject("internetexplorer.application")
For i = 2 To lastRow
If Tabelle1.Cells(i, "M").Value  "Zugestellt" Then
trackingNumber = Tabelle1.Cells(i, "L").Value
trackingURL = "https://www.ups.com/track?loc=de_DE&tracknum=" _
& trackingNumber & _
"&requester=WT&agreeTerms=yes/trackdetails"
IEexp.Visible = True 'False
IEexp.Navigate trackingURL
Do While IEexp.readyState  4: DoEvents: Loop
Application.Wait (Time + TimeValue("00:00:05"))
Set inputElement = IEexp.Document.getElementById("stApp_txtPackageStatus")
If (Not inputElement Is Nothing) Then
Tabelle1.Cells(i, "M").Value = Trim(inputElement.Innertext)
Else
Tabelle1.Cells(i, "M").Value = "Fehler"
End If
End If
Next
IEexp.Quit
Set IEexp = Nothing
Viele Grüße,
Zwenn
Anzeige
AW: zum Thema UPS-Tracking
17.09.2018 16:17:25
PeterK
Hallo
Folgender Code funktioniert bei mir

Sub test()
Dim txt As String
Dim trackingURL As String
Dim IEexp As Object
Set IEexp = CreateObject("internetexplorer.application")
trackingURL = "http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=de_DE& _
" & _
"Requester=UPSHome&tracknum=1Z86W3666898996048&AgreeToTermsAndConditions=yes& _
ignore=&track.x=25&track.y=16"
IEexp.Visible = False
IEexp.Navigate trackingURL
Do While IEexp.readyState  4: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:05"))
txt = IEexp.document.getElementById("stApp_txtPackageStatus").Innertext
MsgBox txt
IEexp.Quit
Set IEexp = Nothing
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige