VBA code - connect to webpage and retrieve value

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:

1. You could add in a test for whether a valid request was made as the json response includes a field for this.
2. 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