Macro VBA to update information in xml file

[Vasilchyk Vladik]

Good day

In general, such a question.
There is an excel file with fields

ID	Name	Price
101	Pos#1	10
102	Pos#2	20

and there is an xml file of this format

<offer available="true" id="101">
<price>10</price>
<currencyId>UAH</currencyId>
<categoryId>91456</categoryId>
<name>Товар №1</name>
<description><![CDATA[
<p>AAAAA.</p>]]></description>
<vendorCode>90/5</vendorCode>
<stock_quantity>1</stock_quantity>
</offer>

The task is that when you press a button in Excel from the desired line, focusing on the product id, information about the updated price is taken and the price in the xml file is updated with a reference to the product id.

That is, I change the price in Excel for 1 product to 12, and the second to 9, and press the macro start button. The price in the required xml file changes according to the principle for the product with id 101, the value in the <price></price> field changes from 10 to 12, and from 20 to 9 from id 102. Nothing else in this file changes.

Thanks for answers
And sorry for my bad english

 

[Domenic]

The following code assumes that the worksheet containing the data is the active sheet. And it also assumes that your XML file contains a root element. The code loops through each row, starting with the second row, and updates the price for the corresponding ID in the specified file.. Change the path and filename for the specified file accordingly. The code should be place in a regular module (Visual Basic Editor or Alt+F11 >> Insert >> Module).

Option Explicit

Sub UpdateXmlFile()

    Dim xmlDoc As Object
    Dim xmlNodeList As Object
    Dim xmlNode As Object
    Dim pathAndFilename As String
    Dim theID As String
    Dim thePrice As String
    Dim recordsEditedCount As Long
    Dim lastRow As Long
    Dim rowIndex As Long
  
    pathAndFilename = "c:\users\domta\desktop\sample.xml" 'change the path and filename accordingly
  
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
  
    If Not xmlDoc.Load(pathAndFilename) Then
        With xmlDoc
            MsgBox "Error " & .parseError.ErrorCode & ": " & .parseError.reason, vbExclamation, "Error"
        End With
        Exit Sub
    End If
  
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
  
    recordsEditedCount = 0
    For rowIndex = 2 To lastRow
        theID = Cells(rowIndex, "A").Value
        thePrice = Cells(rowIndex, "C").Value
        Set xmlNode = xmlDoc.SelectSingleNode("//offer[@id='" & theID & "']/price") 'assumes a root element, hence the double front slash ( // )
        If Not xmlNode Is Nothing Then
            xmlNode.Text = thePrice
            recordsEditedCount = recordsEditedCount + 1
        End If
    Next rowIndex
  
    If recordsEditedCount > 0 Then
        xmlDoc.Save pathAndFilename
    End If
  
    MsgBox "Number of records edited: " & recordsEditedCount
  
    Set xmlDoc = Nothing
    Set xmlNodeList = Nothing
    Set xmlNode = Nothing

  
End Sub

Hope this helps!

 

[Vasilchyk Vladik]

Good afternoon Domenic​

Thanks for your decision. Unfortunately it shows this error on startup.

Error -1 many numbers DTD prohibited

 

[Vasilchyk Vladik]

My table has changed a bit. I uploaded the table itself and the output file to change in the archive Update_xml_xls.zip

The Avaible string updates the value to

available=" "

, Stock in

<stock_quantity> </stock_quantity>

Thanks a lot for your help

 

[Domenic]

Sorry, but I don't download files as a rule, so I haven't looked at them. However, if you're saying that your XML file now includes another element, such as stock_quantity, then it's fine, the code should still work. With regards to your error, try the following code instead...

Option Explicit

Sub UpdateXmlFile()

    Dim xmlDoc As Object
    Dim xmlNodeList As Object
    Dim xmlNode As Object
    Dim pathAndFilename As String
    Dim theID As String
    Dim thePrice As String
    Dim recordsEditedCount As Long
    Dim lastRow As Long
    Dim rowIndex As Long
 
    pathAndFilename = "c:\users\domta\desktop\sample.xml" 'change the path and filename accordingly
 
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
 
    With xmlDoc
        'Wait for the document to load completely
        .async = False
        'Allow the document to include a DTD
        .SetProperty "ProhibitDTD", False
        'Don't validate the document against a DTD or schema
        .validateOnParse = False
    End With
    
    If Not xmlDoc.Load(pathAndFilename) Then
        With xmlDoc
            MsgBox "Error " & .parseError.ErrorCode & ": " & .parseError.reason, vbExclamation, "Error"
        End With
        Exit Sub
    End If
 
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
 
    recordsEditedCount = 0
    For rowIndex = 2 To lastRow
        theID = Cells(rowIndex, "A").Value
        thePrice = Cells(rowIndex, "C").Value
        Set xmlNode = xmlDoc.SelectSingleNode("//offer[@id='" & theID & "']/price") 'assumes a root element, hence the double front slash ( // )
        If Not xmlNode Is Nothing Then
            xmlNode.Text = thePrice
            recordsEditedCount = recordsEditedCount + 1
        End If
    Next rowIndex
 
    If recordsEditedCount > 0 Then
        xmlDoc.Save pathAndFilename
    End If
 
    MsgBox "Number of records edited: " & recordsEditedCount
 
    Set xmlDoc = Nothing
    Set xmlNodeList = Nothing
    Set xmlNode = Nothing

 
End Sub

Hope this helps!

 

[Vasilchyk Vladik]

Good afternoon Domenic​

Thanks for your decision.
Unfortunately for some reason the xml file is not updated.
After launch, a window is displayed "Number of record edited: 0"

 

[Domenic]

It suggests that it didn't find any of those ID's and/or element named price in the specified XML file.

Can you post the exact code that you're using?

Also, can you post a small sample of the exact XML file you're using, including the XML declaration and root element?

Note that I'm logging off for the evening, but I'll look at this as soon as I get a chance.

Cheers!

 

[Vasilchyk Vladik]

Thank you. Somehow figured it out. The price is being updated.
Can you tell me what to change in the code to update other fields from excel in xml
Small piece of code xml

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE yml_catalog SYSTEM "shops.dtd">
<yml_catalog date="2023-01-09 12:00">
    <shop>
        <name></name>
        <company>А</company>
        <url>https://a.com.ua</url>
        <currencies>
            <currency id="UAH" rate="1"/>
        </currencies>
        <categories>
            <category id="6300">Cat1</category>
        </categories>
        <offers>
            
            <offer available="true" id="101">
                <price>11111</price>
                <currencyId>UAH</currencyId>
                <categoryId>6300</categoryId>
                <name>1</name>
                <description><![CDATA[
<p>AAAAA.</p>]]></description>
                <vendorCode>90/5</vendorCode>
                <stock_quantity>10</stock_quantity>
            </offer>
            
        </offers>
    </shop>
</yml_catalog>

 

[Vasilchyk Vladik]

I think I figured out how to pull the value from other elements.
Please tell me how to change the value here

available="true"

value between quotes

 

[Domenic]

Try the following code . . .

Option Explicit

Sub UpdateXmlFile()

    Dim xmlDoc As Object
    Dim xmlNodeList As Object
    Dim xmlNode As Object
    Dim pathAndFilename As String
    Dim theID As String
    Dim thePrice As String
    Dim available As String
    Dim stockQuantity As Long
    Dim recordsEditedCount As Long
    Dim lastRow As Long
    Dim rowIndex As Long
 
    pathAndFilename = "c:\users\domta\desktop\sample.xml" 'change the path and filename accordingly
 
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
 
    With xmlDoc
        'Wait for the document to load completely
        .async = False
        'Allow the document to include a DTD
        .SetProperty "ProhibitDTD", False
        'Don't validate the document against a DTD or schema
        .validateOnParse = False
    End With
    
    If Not xmlDoc.Load(pathAndFilename) Then
        With xmlDoc
            MsgBox "Error " & .parseError.ErrorCode & ": " & .parseError.reason, vbExclamation, "Error"
        End With
        Exit Sub
    End If
 
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
 
    recordsEditedCount = 0
    For rowIndex = 2 To lastRow
        theID = Cells(rowIndex, "A").Value
        thePrice = Cells(rowIndex, "C").Value
        available = Cells(rowIndex, "D").Value
        stockQuantity = Cells(rowIndex, "E").Value
        Set xmlNode = xmlDoc.SelectSingleNode("//offer[@id='" & theID & "']")
        If Not xmlNode Is Nothing Then
            With xmlNode
                .SelectSingleNode("price").Text = thePrice
                .Attributes.getNamedItem("available").Text = LCase(available)
                .SelectSingleNode("stock_quantity").Text = stockQuantity
            End With
            recordsEditedCount = recordsEditedCount + 1
        End If
    Next rowIndex
 
    If recordsEditedCount > 0 Then
        xmlDoc.Save pathAndFilename
    End If
 
    MsgBox "Number of records edited: " & recordsEditedCount
 
    Set xmlDoc = Nothing
    Set xmlNodeList = Nothing
    Set xmlNode = Nothing

 
End Sub

Hope this helps!