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

0 votes

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?

Sep 20, 2022 in Others by Kithuzzz
• 38,020 points
948 views

1 answer to this question.

0 votes
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.
answered Sep 21, 2022 by narikkadan
• 63,720 points

Related Questions In Others

0 votes
1 answer

Remove formulas from all worksheets in Excel using VBA

Try this : Option Explicit Sub test1() ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,720 points
1,913 views
0 votes
1 answer

Copy Text from Range in Excel into Word Document

Here are some articles that may help: Control ...READ MORE

answered Nov 6, 2022 in Others by narikkadan
• 63,720 points
489 views
0 votes
1 answer

Return empty cell from formula in Excel

There is no way to do this ...READ MORE

answered Nov 20, 2022 in Others by narikkadan
• 63,720 points
5,300 views
0 votes
1 answer

How do delete an specific page in a word document using Excel VBA?

Check the code below. I eliminated the ...READ MORE

answered Nov 21, 2022 in Others by narikkadan
• 63,720 points
1,443 views
0 votes
1 answer

Convert image (jpg) to base64 in Excel VBA?

Heres a function. Can't remember where I ...READ MORE

answered Sep 27, 2022 in Others by narikkadan
• 63,720 points
2,853 views
0 votes
1 answer

Rich text format (with formatting tags) in Excel to unformatted text

This function ought to be helpful if ...READ MORE

answered Oct 20, 2022 in Others by narikkadan
• 63,720 points
1,753 views
0 votes
1 answer

Sending excel data to Tally

You can use Requests to send the ...READ MORE

answered Nov 19, 2022 in Others by narikkadan
• 63,720 points
833 views
0 votes
1 answer

How can I preserve the format while exporting data from excel to evernote

The contents for an Evernote note are ...READ MORE

answered Jan 5, 2023 in Others by narikkadan
• 63,720 points
1,049 views
0 votes
1 answer

How to automatically get a specified range of data from Excel to XML in VBA

Range method works, always identify the sheet ...READ MORE

answered Mar 18, 2023 in Others by narikkadan
• 63,720 points
768 views
0 votes
1 answer

Runtime error 438 while importing data in excel from secured website using VBA

Replace With ieDoc.forms(0) .userType.Value = "1" ...READ MORE

answered Sep 23, 2022 in Others by narikkadan
• 63,720 points
840 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP