I am trying to pull the delivery status of specific ups and fedex shipments into an excel file. The ups portion is working fine, but I am having trouble with Fedex . If anyone has a solution, I would be very grateful. Thank you!
Option Explicit
Sub packageStatus()
Dim ie As New InternetExplorer
ie.Visible = False
Dim Doc As HTMLDocument
Dim rng As Range, cell As Range
Dim celltxt As String
Set rng = Range("B6:b9")
For Each cell In rng
celltxt = cell.Offset(0, 2).Text
If InStr(1, celltxt, "1Z") > 0 Then
ie.navigate "http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&tracknum=" & cell.Offset(0, 2).Value & "&AgreeToTermsAndConditions=yes&track.x=17&track.y=4"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set Doc = ie.document
Dim uStatus As String
uStatus = Doc.getElementById("tt_spStatus").innerText
cell.Offset(0, 1) = uStatus
Else
ie.navigate "http://www.fedex.com/Tracking?tracknumbers=" & cell.Offset(0, 2).Value & "&cntry_code=us&clienttype=ivother&"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set Doc = ie.document
Dim fStatus As String
fStatus = Doc.getElementById("container").getElementsByClassName("statusChevron_key_status bogus")
cell.Offset(0, 1) = fStatus
End If
Next cell
End Sub
Option Explicit
Sub packageStatus()
Dim ie As New InternetExplorer
ie.Visible = False
Dim Doc As HTMLDocument
Dim rng As Range, cell As Range
Dim celltxt As String
Set rng = Range("B6:b9")
For Each cell In rng
celltxt = cell.Offset(0, 2).Text
If InStr(1, celltxt, "1Z") > 0 Then
ie.navigate "http://wwwapps.ups.com/WebTracking/processInputRequest?HTMLVersion=5.0&loc=en_US&Requester=UPSHome&tracknum=" & cell.Offset(0, 2).Value & "&AgreeToTermsAndConditions=yes&track.x=17&track.y=4"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set Doc = ie.document
Dim uStatus As String
uStatus = Doc.getElementById("tt_spStatus").innerText
cell.Offset(0, 1) = uStatus
Else
ie.navigate "http://www.fedex.com/Tracking?tracknumbers=" & cell.Offset(0, 2).Value & "&cntry_code=us&clienttype=ivother&"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set Doc = ie.document
Dim fStatus As String
fStatus = Doc.getElementById("container").getElementsByClassName("statusChevron_key_status bogus")
cell.Offset(0, 1) = fStatus
End If
Next cell
End Sub