Предполагая, что я правильно читаю, я думаю, что HTML, возвращаемый сервером, не содержит информацию, которую вы ищете.
Чтобы подтвердить это, попробуйте напечатать:
InStr(1, sResponse, "redesignStatusChevronTVC tank-results-item__data-label-large tank-text-center statusChevron_key_status", vbTextCompare)
до ближайшего окна, и вы должны увидеть, что оно возвращает 0 (что означает, что текст отсутствует в тексте ответа).
Информация, которую вы пытаетесь очистить (и даже элемент, который нужно выбрать с помощью .redesignStatusChevronTVC.tank-results-item__data-label-large.tank-text-center.statusChevron_key_status), динамически заполняется с помощью JavaScript и не существует в то время, когда вы пытаетесь получить к нему доступ.
Из того, что я вижу, веб-страница делает запрос HTTP POST, и сервер возвращает некоторое JSON, которое представляет информацию, относящуюся к этому номеру отслеживания. Попробуйте приведенный ниже код (запустите процедуру JustATest), которая пытается выполнить тот же HTTP-запрос POST:
Option Explicit
Private Sub JustATest()
MsgBox "Delivery status is: " & GetDeliveryStatusForPackage("475762806100", "en_IN")
End Sub
Private Function GetDeliveryStatusForPackage(ByVal trackingNumber As String, ByVal localeValue As String)
' Given a "trackingNumber" and "localeValue", should return the delivery status of that package.
Dim jsonResponse As String
jsonResponse = GetFedExJson(trackingNumber, localeValue)
GetDeliveryStatusForPackage = ExtractDeliveryStatusFromJson(jsonResponse)
End Function
Private Function ExtractDeliveryStatusFromJson(ByVal someJson As String) As String
' Should extract the delivery status. This function treats the JSON
' encoded string as a string and hence relies on basic string matching.
Const START_DELIMITER As String = """keyStatus"":"""
Dim startDelimiterIndex As Long
startDelimiterIndex = InStr(1, someJson, START_DELIMITER)
Debug.Assert startDelimiterIndex > 0
startDelimiterIndex = startDelimiterIndex + Len(START_DELIMITER)
Dim endDelimiterIndex As Long
endDelimiterIndex = InStr(startDelimiterIndex + 1, someJson, """", vbBinaryCompare)
Debug.Assert endDelimiterIndex > 0
ExtractDeliveryStatusFromJson = Mid$(someJson, startDelimiterIndex, endDelimiterIndex - startDelimiterIndex)
End Function
Private Function GetFedExJson(ByVal trackingNumber As String, ByVal localeValue As String) As String
' Should return a JSON-encoded response. The return value can be
' passed to a function that parses JSON (if such a function is available for use).
Dim formToPost As String
formToPost = CreateFedExForm(trackingNumber, localeValue)
Const TARGET_URL As String = "https://www.fedex.com/trackingCal/track"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", TARGET_URL, False
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/79.0.3945.130 Safari/537.36"
.Send formToPost
Debug.Assert InStr(1, .ResponseText, "{""TrackPackagesResponse"":{""successful"":true,", vbBinaryCompare)
GetFedExJson = .ResponseText
End With
End Function
Private Function CreateFedExForm(ByVal trackingNumber As String, ByVal localeValue As String) As String
' Should return a string representing a form of URL encoded name-value pairs.
Dim data As String
data = "{""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":""" & trackingNumber & """,""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
CreateFedExForm = "data=" & Application.EncodeURL(data) & "&action=trackpackages&locale=" & Application.EncodeURL(localeValue) & "&version=1&format=json"
End Function
- Если это работает, то функция
GetDeliveryStatusForPackage кажется способной возврата статуса доставки данных trackingNumber и localeValue. - Стоит отметить, что JSON, возвращаемый сервером, содержит другую информацию (которую вы не запрашивали в своем вопросе, но вы можете найти соответствующие / полезные). Публиковать здесь слишком долго, но вы можете исследовать это сами.
- Я думаю, что можно получить информацию для нескольких номеров отслеживания в одном запросе. (Я говорю это, потому что в запросе
TrackPackagesRequest.trackingInfoList является массивом, а в ответе TrackPackagesResponse.packageList также является массивом). Это просто предположение / рациональное предположение на данном этапе, но может быть то, что может потенциально сократить время, необходимое вашему коду до конечного sh. - Возможно, стоит получить модуль VBA (https://github.com/VBA-tools/VBA-JSON), который поддерживает синтаксический анализ JSON. Я не беспокоился, так как вы хотели только статус доставки. Но десериализация ответа будет правильным способом сделать это (особенно с точки зрения доступа к правильному пути свойства).
- Возможно, вы также захотите проверить, явно ли запрещают условия, регулирующие использование вами их сайта. веб-очистка или любые другие подобные действия.
Что касается значения вложенного свойства keyStatus, равного "In transit" для недопустимых номеров отслеживания, проверьте путь свойства TrackPackagesResponse.packageList[0].errorList[0], где есть объект. Для недопустимых номеров отслеживания это, кажется, {"code":"1041","message":"This tracking number cannot be found. Please check the number or contact the sender."... - и для действительных номеров отслеживания свойства code и message выглядят как строки нулевой длины.
Возможно, было бы хорошо получить модуль VBA JSON, о котором я упоминал выше, поскольку имеется два объекта errorList (на разных уровнях вложенности), и вы хотите убедиться, что вы обращаетесь к нужному объекту.
Требуется изменение в код, вероятно, будет в первую очередь проверять, указывают ли свойства code и message на TrackPackagesResponse.packageList[0].errorList[0], что номер отслеживания недействителен (и возвращать message, если он недействителен). В противном случае верните TrackPackagesResponse.packageList[0].keyStatus. У меня нет времени, чтобы реализовать эти изменения прямо сейчас. Но я думаю, что это то, что вы можете сделать (если вы действительно не уверены, в таком случае дайте мне знать, с каким битом вам нужна помощь).