Excel vba domdocument parsing xml from TNT tracking system in some pcs object load return no document

Question

I use the following query URL as an example to parse an XML document that I received from TNT courier's tracking system: https://www.tnt.it/tracking/getXMLTrack?WT=1&ConsigNos=RL38536236

Prior to yesterday, every PC had the functionality working as intended. The DocumentElement property is null and the Load(URL) of the DOMDocument object produces a false result, The curious thing is that the XML displays perfectly if I navigate to that site using Firefox, Chrome, Edge, or Internet Explorer.

Code:

Function TrackTNTlist(LDV As String) As Collection

Dim TNTlist As New Collection

Dim Obj As MSXML2.DOMDocument60
Dim Verifica As Boolean
Dim XMLTNT As String

Dim NodoLista As IXMLDOMNodeList
Dim NodoSingolo As IXMLDOMNode
Dim Nome As IXMLDOMNode
Dim DataConsegna As IXMLDOMNode
Dim NomeRicevente As IXMLDOMNode
Dim Destinatario As IXMLDOMNode
Dim ConsignmentDetails As IXMLDOMNode
Dim DataPrevConsegna As IXMLDOMNode
Dim NuovaLDV As IXMLDOMNode
Dim Dest As String, DatiSped As String

On Error GoTo RigaErrore

XMLTNT = "https://www.tnt.it/tracking/getXMLTrack?WT=1&ConsigNos=" & LDV

Set Obj = New MSXML2.DOMDocument60
Obj.async = False
Verifica = Obj.Load(XMLTNT)

If Verifica = True Then
    MsgBox "File XML " & XMLTNT & "loaded"
Else
    MsgBox "File XML NOT loaded"
    TNTlist.Add "ERROR - XML tracking data not loaded"
    Exit Function
End If

Set NodoSingolo = Obj.DocumentElement.SelectSingleNode("Consignment/StatusDetails/StatusDescription")

If NodoSingolo Is Nothing Then

    TNTlist.Add "LDV non trovata"

Else
    Set NodoList = Obj.DocumentElement.SelectNodes("Consignment/StatusDetails")
    Set ConsignmentDetails = Obj.DocumentElement.SelectSingleNode("Consignment/ConsignmentDetails")

    DatiSped = ""
    DatiSped = "LETTERA DI VETTURA: " & LDV & Chr(10)
    
    If Not ConsignmentDetails Is Nothing Then
        DatiSped = DatiSped & "RIF. MITTENTE: " & ConsignmentDetails.ChildNodes(0).Text & Chr(10)
        DatiSped = DatiSped & "TIPO SERVIZIO: " & ConsignmentDetails.ChildNodes(1).Text & Chr(10)
        DatiSped = DatiSped & "NUM. COLLI: " & ConsignmentDetails.ChildNodes(3).Text & Chr(10)
    End If
    
    
    Set NodoSingolo = Obj.DocumentElement.SelectSingleNode("Consignment/StatusDetails/StatusDescription")
    
    Dest = ""
    Set DataConsegna = Obj.DocumentElement.SelectSingleNode("Consignment/DeliveryDate")
    Set NomeRicevente = Obj.DocumentElement.SelectSingleNode("Consignment/CollectionName")
    Set Destinatario = Obj.DocumentElement.SelectSingleNode("Consignment/ReceiverDetails")
    Set DataPrevConsegna = Obj.DocumentElement.SelectSingleNode("Consignment/DueDate")
    Set NuovaLDV = Obj.DocumentElement.SelectSingleNode("Consignment/HeldInDepotDetails/HID1ReplacingDoc")
    
    If NodoSingolo.Text = "Spedizione consegnata" Then
        Dest = "CONSEGNATA A: " & Chr(13)
    Else
        Dest = "PREVISTA CONSEGNA A: " & Chr(10)
    End If
    
    If Not Destinatario Is Nothing Then
        Dest = Dest & Destinatario.ChildNodes(4).Text
        Dest = Dest & " (" & Destinatario.ChildNodes(6).Text & ")" & Chr(10)
    End If
    
    If Not DataPrevConsegna Is Nothing Then
        Dest = Dest & DataPrevConsegna.ChildNodes(0).Text & Chr(10)
    End If

    
    If Not DataConsegna Is Nothing Then
        Dest = Dest & "Data consegna: " & DataConsegna.Text & Chr(10)
    End If
    
    If Not NomeRicevente Is Nothing Then
        Dest = Dest & "Ha ritirato: " & NomeRicevente.Text & Chr(10)
    End If
    
    If Not NuovaLDV Is Nothing Then
        Dest = Dest & "NUOVA LETTERA DI VETTURA: " & NuovaLDV.Text & Chr(10)
    End If
    
    Dest = Dest & "Dettaglio tracking:" & Chr(10)
    
    TNTlist.Add DatiSped & Chr(10) & Dest & Chr(10)
    
    For Each Nome In NodoList
        
        TNTlist.Add Nome.ChildNodes(1).Text
        TNTlist.Add Nome.ChildNodes(2).Text
    
    Next
    
End If

salto = 1
If salto <> 1 Then
    Set NodoSingolo = Obj.DocumentElement.SelectSingleNode("Consignment/StatusDetails/StatusDescription")
    
    
    If NodoSingolo Is Nothing Then
        TNTlist.Add "LDV non trovata"
    Else
        If NodoSingolo.Text = "Spedizione consegnata" Then

            Set DataConsegna = Obj.DocumentElement.SelectSingleNode("Consignment/DeliveryDate")
            Set NomeRicevente = Obj.DocumentElement.SelectSingleNode("Consignment/CollectionName")
            Set Destinatario = Obj.DocumentElement.SelectSingleNode("Consignment/ReceiverDetails")
            Dest = Destinatario.ChildNodes(4).Text
            Dest = Dest & " (" & Destinatario.ChildNodes(5).Text & ")"
            
            TNTlist.Add NodoSingolo.Text & " : " & Dest & " - " & NomeRicevente.Text & " - " & DataConsegna.Text
            TNTlist.Add DataConsegna.Text
        
        End If
    
    End If
End If

Set TrackTNTlist = TNTlist

Exit Function

RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Application.EnableEvents = True
Resume Next

End Function

Below are two screenshots, one from a computer where the function works correctly and one from another where the problem occurs. The problem only affects a small number of computers, all of which have identical system configurations. screenshot showing a problem with proper execution:

debug screenshot of correct execution

debug screenshot of error execution

When visiting the URL on both PCs, the XML is displayed appropriately. Could someone please explain the potential causes of the issue to me?

Answer 1

This error is related to something in the XML which is not wrong. please check if you have an LDV which generates an error on some PCs. Please have a look at DOMDocument.parseError. Simplest usage in your code: MsgBox "File XML NOT loaded. Reason: " & Obj.parseError.reason.