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:
Vlookup version 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?
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