VBA code - connect to webpage and retrieve value - excel

Question

I have the following
Column A == FEdEX AWB #s
Column B == Delivery date (Empty)
I would like to write a function where it reads the tracking number on Column A and extracts the delivery date from the website - all AWB # are delivered - 100% sure
The code I have writes all the info found in the website into the sheet - not sure how to extract only the delivered date.
Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.bing.com/packagetrackingv2?
packNum=727517426234&carrier=Fedex&FORM=PCKTR1" _
, Destination:=Range("$A$1"))
.Name = _
"https://www.bing.com/packagetrackingv2?
packNum=727517426234&carrier=Fedex&FORM=PCKTR1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

Answer 1

A function, getting passing the airway bill number and returning the date would be quite enough:
Function GetDateFromAwb(awbNumber As String) As String
Dim objIE As New InternetExplorer 'Microsoft Internet Controls library added
objIE.Visible = False 'Or put True, if you want to see the IE
objIE.navigate "https://www.fedex.com/apps/fedextrack/?tracknumbers=" & awbNumber
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:05"))
GetDateFromAwb = objIE.Document.getElementsByClassName("redesignSnapshotTVC snapshotController_date dest").Item.InnerText
objIE.Quit
End Function
The idea of the function is to append the airbill string number to the URL and to open the corresponding site. Then, using the class "redesignSnapshotTVC snapshotController_date dest", the corresponding date is taken.
This is a possible way to call the function, displaying the date in a MsgBox:
Sub Main()
Dim awbNumber As String
awbNumber = 727517426234#
Dim awbDate As String
awbDate = GetDateFromAwb(awbNumber)
MsgBox awbDate
End Sub
Make sure that the library "Microsoft Internet Controls" is added from the VBE menu>Extras>References:

Answer 2

Rather than using a browser you could use xmlhttp request which is quicker.
The page does a form XHR POST request which returns json you can parse (lots of info returned including a delivery date field). You can use this as a function in the sheet. I also show a test call. The id (tracking number) is passed as an argument to the function GetDeliveryDate.
Here is the request made when you submit your tracking number on the site:
As you can see from the above, and further detailed in code, the tracking number is part of the body sent in the request (data param); it is also part of one of the request headers.
I use jsonconverter.bas to parse the json response. After adding the code from there to your project you need go VBE > Tools > References and add a reference to Microsoft Scripting Runtime.
View the json response here
As you say all requests will return a delivery date, if you don't want to load this external library you could use split to isolate the date.
Relevant json:
You can see relevant part of json here:
I use the field actDeliveryDt for version of code using split as I can separate an unambiguous date yyyy-mm-dd from the datetime string. I use displayActDeliveryDt for json parsing though you could use either (removing time part with split if usnig the former as shown in examples below)
Caveat: I have had only one delivery id to use for testing.
TODO:
You could add in a test for whether a valid request was made as the json response includes a field for this.
If performing this for multiple requests I would recommend, for efficiency, to re-write using a sub which loops an array of the tracking numbers, stores results in an array and writes that array out in go at end.
VBA:
JSON parsing:
Option Explicit 'example test call from VBE
Public Sub test()
Debug.Print GetDeliveryDate(727517426234#)
End Sub
Public Function GetDeliveryDate(ByVal id As Double) As Date
Dim json As Object, body As String '< VBE > Tools > References > Microsoft Scripting Runtime
body = "data={""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":" & Chr$(34) & CStr(id) & Chr$(34) & ",""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
body = body & "&action=trackpackages&locale=en_US&version=1&format=json"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://www.fedex.com/trackingCal/track", False
.setRequestHeader "Referer", "https://www.fedex.com/apps/fedextrack/?tracknumbers=" & CStr(id)
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send body
Set json = JsonConverter.ParseJson(.responseText)
End With
GetDeliveryDate = json("TrackPackagesResponse")("packageList")(1)("displayActDeliveryDt")
End Function
Using split:
Option Explicit
Public Sub test()
Debug.Print GetDeliveryDate(727517426234#)
End Sub
Public Function GetDeliveryDate(ByVal id As Double) As Date
Dim s As String, body As String
body = "data={""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":" & Chr$(34) & CStr(id) & Chr$(34) & ",""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
body = body & "&action=trackpackages&locale=en_US&version=1&format=json"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://www.fedex.com/trackingCal/track", False
.setRequestHeader "Referer", "https://www.fedex.com/apps/fedextrack/?tracknumbers=" & CStr(id)
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send body
s = .responseText
End With
GetDeliveryDate = Split(Replace$(Split(Split(s, """actDeliveryDt"":""")(1), Chr$(34))(0), "\u002d", "-"), "T")(0)
End Function
Example usage in sheet:
Note: I have UK format dd/mm/yyyy in sheet