根据.csv文件更新.xml文档 [英] Updating an .xml document according to a .csv file
问题描述
我是VBA的新手，我正在努力寻找解决问题的方法.基本上，我需要根据.csv文档的内容编辑.xml文件中的某些节点.
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.
尤其是，每当我遍历XML文档(即"C:\ Users \ xxx \ Desktop \ ppp.xml")时，我偶然发现一个特定的节点(将其命名为 thing >)，我需要阅读该节点的文本并在CSV文件中查找它(即C:\ Users \ xxx \ Desktop \ mycopy.csv").然后在同一XML文件中编辑其他节点的文本(将其命名为 qt ).我在考虑以下理由:
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:
- 由于XML文件的编辑(下面我使用Microsoft XML，v3.0)需要根据.csv内容进行.
- 我首先将CSV转换为Excel工作簿(.xlsx)(我对管理CSV文件了解不多，所以这种方式对我来说更易于管理).
- 然后在VBA中执行某种
Vlookup版本.
如果我单独运行下面显示的这段代码，那很好.因为我知道VBA中的一些XML，所以我对如何编辑节点和属性有基本的了解.但是，我很难将XML文件链接到Excel工作簿.我看了VBA中的许多XML编辑示例，但是编辑是根据相同的XML执行的，而无需在其他文件中查找值.我将发布代码示例，但显然不起作用，希望它足够清晰.谢谢.
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
由于我尚未定义 rngFound (这是我的Vlookup搜索的结果).
Since I haven't defined rngFound yet (this would be the result of my Vlookup search).
我遵循的逻辑是否有意义，还是需要从头开始重写代码?是否可以避免CSV文件的Excel .xlsx转换，而直接在CSV中进行搜索?
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?
更新(回答Tim Williams的问题) 在代码的以下部分中，我需要更新每个节点事物"的文本.加上.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?
推荐答案
未经测试，但我认为应该是正确的.由于找到一个范围内的所有匹配单元"，因此我喜欢使用一个独立的函数来完成此任务，而不是使用该逻辑使主代码变得混乱.
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
这篇关于根据.csv文件更新.xml文档的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
