根据.csv文件更新.xml文档

Question

我是VBA的新手，我正在努力寻找解决问题的方法。基本上，我需要做的是根据.csv文档的内容编辑.xml文件中的一些节点。

特别是，每当我循环浏览XML文档(即"C:\Users\xxx\Desktop\pppp.XML"(，偶然发现某个特定节点(假设它是thing(时，我需要读取该节点的文本，并在CSV文件(即C:\Users\xxx \Deskt\mycopy.CSV"(中查找它。然后在同一XML文件中编辑不同节点的文本(假设它为qt(。我在思考以下理由：

1. 由于XML文件编辑(下面我使用的是Microsoft XML v3.0(需要根据.csv内容进行
2. 我首先将CSV转换为Excel工作簿(.xlsx((我对管理CSV文件不太了解，所以这种方式对我来说更容易管理(
3. 然后在VBA中执行一种Vlookup版本

如果我单独运行下面显示的这部分代码，效果很好。由于我了解VBA中的一些XML，我对如何编辑节点和属性有了基本的了解。但是，我很难将XML文件链接到Excel工作簿。我看了很多VBA中的XML编辑示例，但编辑是根据相同的XML执行的，而不需要在不同的文件中查找值。我会发布一个我的代码示例，它显然不起作用，希望它足够清晰。谢谢

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:UsersxxxDesktopppp.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:UsersxxxDesktopmycopy.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 

我很清楚，代码中没有意义的部分如下：

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

由于我还没有定义rngFound(这将是我的Vlookup搜索的结果(。

我遵循的逻辑是否有意义，或者代码是否需要从头开始重写？是否可以避免CSV文件的Excel.xlsx转换，从而直接在CSV中进行搜索？

更新(回答Tim Williams的问题(在代码的以下部分，我需要更新每个节点的文本"事物；.csv文件中两个单元格的乘积，类似

If thing.Text = rngFound Then
q.Text = ws.Range("A:A").value*ws.Range("K:K").value
End If

是否可以将类似偏移函数的东西应用于集合对象中的元素？我知道偏移只能应用于一个范围，所以我认为需要为此创建一个新函数，对吗？

Answer 1

未测试，但我认为应该是正确的。由于"；查找范围"0"中的所有匹配单元格；是一个非常常见的任务，我喜欢使用一个独立的函数来实现这一点，而不是用那个逻辑来扰乱主代码。

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:UsersxxxDesktopppp.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:UsersxxxDesktopmycopy.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

Answer 2

任何需要编辑XML的时候，都可以考虑XSLT，这是一种专门用于转换XML文件的编程语言(可以在VBA中分层(。具体来说，您可以通过CSV导入进行迭代，将值传递到参数化的XSLT中。

为了演示(直到OP包括示例数据(，下面使用前三个vba和xslt1StackOverflow用户的XML：

数据

XML (注意要更新的空<total_rep>节点(

<?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

马丁·霍宁

用户	total_rep
Siddharth Rout	134062
Scott Craner	123313
Tim Williams	116760
Dimitre Novatchev	227632
Michael Kay	135177