问题
I'm quite of a newbie in VBA, and I'm struggling to find a solution to my problem. Basically, what I need to do is editing some nodes in an .xml file according to the content of a .csv document.
In particular, whenever I loop through the XML document (i.e., "C:\Users\xxx\Desktop\ppp.xml") and I stumble upon a particular node (let it be thing), I need to read the text of that node and look for it in the CSV file (i.e., C:\Users\xxx\Desktop\mycopy.csv"). Then edit the text of a different node (let it be qt) in the same XML file. I was thinking about the following rationale:
- Since the XML file editing (below I used Microsoft XML, v3.0) needs to be done according to the .csv content.
- I firstly converted the CSV into a Excel workbook (.xlsx) (I don't know much of managing CSV files, so that way was more manageable for me).
- Then perform a sort of
Vlookupversion in VBA.
That works fine, if I run separately this part of the code shown below. Since I know some XML in VBA, I have a basic knowledge of how to edit nodes and attributes. However, I struggle to link the XML file to the Excel workbook. I've taken a look to a lot of XML editing examples in VBA, but the editing is performed according to the same XML, without looking for a value in a different file. I'll post a sample of my code, which obviously doesn't work, hoping it's clear enough. Thanks.
Option Explicit
Sub editxml()
Dim Obj As DOMDocument
Dim xmlpath As String
Dim loadcheck As Boolean
Dim Node As IXMLDOMNodeList
Dim Nm As IXMLDOMNode
Dim thing As Object, q As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim mycsvfile As String
Dim i As Integer, numcol As Integer
Dim line As String
Dim row As Integer
Dim matrix As Variant
Dim rngSearch As Range, rngLast As Range, rngFound As Range
Dim strFirstAddress As String
Set Obj = New DOMDocument
Obj.async = False: Obj.validateOnParse = False
xmlpath = "C:\Users\xxx\Desktop\ppp.xml"
Obj.SetProperty "SelectionNamespaces", "xmlns:ns0='http://update.DocumentTypes.Schema.ppp.Xml'"
loadcheck = Obj.Load(xmlpath)
If loadcheck = True Then
MsgBox "File XML uploaded"
Else
MsgBox "File XML not uploaded"
End If
Set Node = Obj.DocumentElement.SelectNodes("AA/BB/CC/DD")
For Each Nm In Node
Set thing = Nm.SelectSingleNode("thing")
Set q = Nm.SelectSingleNode("qt")
If thing.Text = rngFound Then
q.Text = "do somewhat else"
End If
Next
Obj.Save (xmlpath)
Set wb = Workbooks.Add
wb.SaveAs Filename:="csvtoxlsxfind" & ".xlsx"
Set ws = wb.Sheets(1)
With ws
row = 1
mycsvfile = "C:\Users\xxx\Desktop\mycopy.csv"
Open mycsvfile For Input As #1
Do Until EOF(1)
Line Input #1, line
matrix = Split(line, ",")
numcol = UBound(matrix) - LBound(matrix) + 1
For i = 1 To numcol
Cells(row, i) = matrix(i - 1)
Next i
row = row + 1
Loop
Close #1
'set the search range, i.e where I have to find the value:
Set rngSearch = .Range("AR:AR")
'specify last cell in range:
Set rngLast = rngSearch.Cells(rngSearch.Cells.Count)
'Find the "thing" in search range, when it first occurrs (rngFound=1st occurrence).
Set rngFound = rngSearch.find(What:=thing.Text, After:=rngLast, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'if the "thing" is found in search range:
If Not rngFound Is Nothing Then
'saves the address of the first occurrence of the "thing" in the strFirstAddress variable:
strFirstAddress = rngFound.Address
Do
'Find next occurrence of the "thing".
MsgBox rngFound.Address & " " & rngFound.Offset(0, -29).Value * rngFound.Offset(0, -6)
Set rngFound = rngSearch.FindNext(rngFound)
rngFound.Font.Color = vbRed
rngFound.Offset(0, -40).Font.Color = vbRed
Loop Until rngFound.Address = strFirstAddress
Else
MsgBox "thing not found"
End If
End With
End Sub
I'm well aware that the part of the code that doesn't make sense is the following:
For Each Nm In Node
Set thing = Nm.SelectSingleNode("thing")
Set q = Nm.SelectSingleNode("qt")
If thing.Text = rngFound Then
q.Text = "do somewhat else"
End If
Next
Since I haven't defined rngFound yet (this would be the result of my Vlookup search).
Does the logic I followed make some sense, or the code needs to be rewritten from scratch? Is is possible to avoid the Excel .xlsx conversion of the CSV file, and so doing the search directly in the CSV?
Update (answering to Tim Williams' question) In the following part of the code, I need to update the text of every node "thing" with the product of two cells in the .csv file, something like
If thing.Text = rngFound Then
q.Text = ws.Range("A:A").value*ws.Range("K:K").value
End If
Would it be possible to apply something like offset function to the elements in the collection object? I know that offset can only be applied to a range, so I think a new function needs to be created for that purpose, am I right?
回答1:
Untested but should be about right I think. Since "find all matching cells in a range" is a pretty common task I like to use a standalone function for that, instead of cluttering the main code with that logic.
Sub editxml()
Dim Obj As MSXML2.DOMDocument60
Dim xmlpath As String
Dim Node As IXMLDOMNodeList
Dim Nm As IXMLDOMNode
Dim thing As Object, q As Object
Dim wb As Workbook, ws As Worksheet
Dim matches As Collection
Set Obj = New DOMDocument60
Obj.async = False
Obj.validateOnParse = False
xmlpath = "C:\Users\xxx\Desktop\ppp.xml"
Obj.SetProperty "SelectionNamespaces", "xmlns:ns0='http://update.DocumentTypes.Schema.ppp.Xml'"
If Obj.Load(xmlpath) = True Then
MsgBox "File XML uploaded"
Else
MsgBox "File XML not uploaded"
Exit Sub
End If
'open the CSV file
Set wb = Workbooks.Open("C:\Users\xxx\Desktop\mycopy.csv")
Set ws = wb.Worksheets(1)
Set Node = Obj.DocumentElement.SelectNodes("AA/BB/CC/DD")
For Each Nm In Node
Set thing = Nm.SelectSingleNode("thing")
Set q = Nm.SelectSingleNode("qt")
'moved the Find logic to a standalone function
Set matches = FindAll(ws.Range("AR:AR"), thing.Text)
'did we get any matches in the range?
If matches.Count > 0 Then
'It's not clear what should go here - are you replacing
' with some other text from the CSV, or just a fixed value?
q.Text = "do somewhat else"
'you can apply formatting to the found cells here...
End If
Next
Obj.Save xmlpath
End Sub
'find all matching cells in a range and return them in a Collection
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range, addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address() 'store first cell found
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do 'exit if we've looped back to first cell
Loop
Set FindAll = rv
End Function
回答2:
Anytime you need to edit an XML, consider XSLT, the special purpose programming language (that can be layered in VBA) designed to transform XML files. Specifically for your case, you can iterate through a CSV import to pass values into a paramterized XSLT.
To demonstrate (until OP includes sample data) below uses an XML of the top three vba and xslt StackOverflow users:
Data
XML (Notice empty <total_rep> nodes to be updated)
<?xml version="1.0"?>
<stackoverflow>
<group lang="vba">
<topusers>
<user>Siddharth Rout</user>
<link>https://stackoverflow.com/users/1140579/siddharth-rout</link>
<location>Mumbai, India</location>
<total_rep></total_rep>
<tag1>excel</tag1>
<tag2>vba</tag2>
<tag3>excel-formula</tag3>
</topusers>
<topusers>
<user>Scott Craner</user>
<link>https://stackoverflow.com/users/4851590/scott-craner</link>
<location>Flyover Country</location>
<total_rep></total_rep>
<tag1>excel</tag1>
<tag2>vba</tag2>
<tag3>excel-formula</tag3>
</topusers>
<topusers>
<user>Tim Williams</user>
<link>https://stackoverflow.com/users/478884/tim-williams</link>
<location>San Francisco, CA, United States</location>
<total_rep></total_rep>
<tag1>vba</tag1>
<tag2>excel</tag2>
<tag3>arrays</tag3>
</topusers>
</group>
<group lang="xslt">
<topusers>
<user>Dimitre Novatchev</user>
<link>https://stackoverflow.com/users/36305/dimitre-novatchev</link>
<location>United States</location>
<total_rep></total_rep>
<tag1>xslt</tag1>
<tag2>xml</tag2>
<tag3>xpath</tag3>
</topusers>
<topusers>
<user>Martin Honnen</user>
<link>https://stackoverflow.com/users/252228/martin-honnen</link>
<location>Germany</location>
<total_rep></total_rep>
<tag1>xslt</tag1>
<tag2>xml</tag2>
<tag3>xpath</tag3>
</topusers>
<topusers>
<user>Michael Kay</user>
<link>https://stackoverflow.com/users/415448/michael-kay</link>
<location>Reading, United Kingdom</location>
<total_rep></total_rep>
<tag1>xml</tag1>
<tag2>xslt</tag2>
<tag3>xpath</tag3>
</topusers>
</group>
</stackoverflow>
CSV
| user | total_rep |
|---|---|
| Siddharth Rout | 134,062 |
| Scott Craner | 123,313 |
| Tim Williams | 116,760 |
| Dimitre Novatchev | 227,632 |
| Martin Honnen | 134,713 |
| Michael Kay | 135,177 |
XSLT
(Save below as .xsl file, a special .xml file, to be loaded in VBA)
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output indent="yes" encoding="UTF-8"/>
<xsl:strip-space elements="*"/>
<!-- INITIALIZE PARAMS -->
<xsl:param name="user_param"/>
<xsl:param name="total_rep_param"/>
<!-- IDENTITY TRANSFORM -->
<xsl:template match="@*|node()">
<xsl:copy>
<xsl:apply-templates select="@*|node()"/>
</xsl:copy>
</xsl:template>
<!-- CONDITIONALLY UPDATE TEXT BY DIFFERENT NODE MATCH -->
<xsl:template match="topusers">
<xsl:copy>
<xsl:apply-templates select="user|link|location"/>
<total_rep>
<xsl:choose>
<xsl:when test="user = $user_param">
<xsl:value-of select="$total_rep_param"/>
</xsl:when>
<xsl:otherwise>
<xsl:value-of select="total_rep"/>
</xsl:otherwise>
</xsl:choose>
</total_rep>
<xsl:apply-templates select="tag1|tag2|tag3"/>
</xsl:copy>
</xsl:template>
</xsl:stylesheet>
VBA
(Two subroutines to load CSV and transform XML, parameter names to match above in XSLT)
Sub LoadCSV()
Dim csv_file As String
csv_file = "C:\Path\To\File.csv"
With ThisWorkbook.Worksheets("Sheet1")
.Columns("A:D").EntireColumn.Delete
With .QueryTables.Add(Connection:="TEXT;" & csv_file, _
Destination:=.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
.QueryTables(1).SaveData = False
.QueryTables.Item(1).Delete
End With
End Sub
Sub TransformXML()
' REFERENCE Microsoct XML, v6.0
Dim xmlDoc As MSXML2.DOMDocument60
Dim xslDoc As MSXML2.FreeThreadedDOMDocument60
Dim xslTemp As MSXML2.XSLTemplate60
Dim xslProc As Object
Dim i As Long, lastrow As Long
Dim param1 As Variant, param2 As Variant
Call LoadCSV ' LOAD CSV FILE
Set xmlDoc = New MSXML2.DOMDocument60 ' LOAD XML FILE
xmlDoc.Load "C:\Path\To\Input.xml"
Set xslDoc = New MSXML2.DOMDocument60 ' LOAD XSL SCRIPT
xslDoc.Load "C:\Path\To\Script.xsl"
' INITIALIZE NEEDED OBJECTS
Set xslTemp = New MSXML2.XSLTemplate60
Set xslTemp.stylesheet = xslDoc
Set xslProc = xslTemp.createProcessor()
With ThisWorkbook.Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
' ITERATE THROUGH CSV DATA
For i = 2 To lastrow
param1 = .Range("A" & i).Value
param2 = .Range("B" & i).Value
With xslProc
.input = xmlDoc
.addParameter "user_param", param1 ' ADD PARAMETER(S)
.addParameter "total_rep_param", param2
.transform ' TRANSFORM XML
xmlDoc.LoadXML .output ' LOAD RESULT TREE
End With
Next i
End With
xmlDoc.Save "C:\Path\To\Output.xml" ' SAVE OUTPUT TO FILE
Set xmlDoc = Nothing: Set xslDoc = Nothing
Set xslTemp = Nothing: Set xslProc = Nothing
End Sub
Output
(Notice <total_rep> populated from CSV)
<?xml version="1.0"?>
<stackoverflow>
<group lang="vba">
<topusers>
<user>Siddharth Rout</user>
<link>https://stackoverflow.com/users/1140579/siddharth-rout</link>
<location>Mumbai, India</location>
<total_rep>134062</total_rep>
<tag1>excel</tag1>
<tag2>vba</tag2>
<tag3>excel-formula</tag3>
</topusers>
<topusers>
<user>Scott Craner</user>
<link>https://stackoverflow.com/users/4851590/scott-craner</link>
<location>Flyover Country</location>
<total_rep>123313</total_rep>
<tag1>excel</tag1>
<tag2>vba</tag2>
<tag3>excel-formula</tag3>
</topusers>
<topusers>
<user>Tim Williams</user>
<link>https://stackoverflow.com/users/478884/tim-williams</link>
<location>San Francisco, CA, United States</location>
<total_rep>116760</total_rep>
<tag1>vba</tag1>
<tag2>excel</tag2>
<tag3>arrays</tag3>
</topusers>
</group>
<group lang="xslt">
<topusers>
<user>Dimitre Novatchev</user>
<link>https://stackoverflow.com/users/36305/dimitre-novatchev</link>
<location>United States</location>
<total_rep>227632</total_rep>
<tag1>xslt</tag1>
<tag2>xml</tag2>
<tag3>xpath</tag3>
</topusers>
<topusers>
<user>Martin Honnen</user>
<link>https://stackoverflow.com/users/252228/martin-honnen</link>
<location>Germany</location>
<total_rep>134713</total_rep>
<tag1>xslt</tag1>
<tag2>xml</tag2>
<tag3>xpath</tag3>
</topusers>
<topusers>
<user>Michael Kay</user>
<link>https://stackoverflow.com/users/415448/michael-kay</link>
<location>Reading, United Kingdom</location>
<total_rep>135177</total_rep>
<tag1>xml</tag1>
<tag2>xslt</tag2>
<tag3>xpath</tag3>
</topusers>
</group>
</stackoverflow>
来源：https://stackoverflow.com/questions/65703113/updating-an-xml-document-according-to-a-csv-file