Program, that optimizing the process of working with XML files - excel

Question

Sorry for my bad English :( I have a task - i should write a program in Excel VBA,that will in folder and subfolders find all .xml files, scan them and make changes if it necessary. Then program will save all changed files in the folder with name "Todays date_changed" and all non-changed files just transfer to the folder with name "Today date". In the end program should display message about how many files was changed and non-changed. I've already wrote code, that changed .xml file in the proper condition. Here it is:
Sub EditXML()
Dim doc As New DOMDocument
Const filePath As String = "D:\Test3.xml" 'path to the editing file
Dim isLoaded As Boolean
isLoaded = doc.Load(filePath)
If isLoaded Then
Dim oAttributes As MSXML2.IXMLDOMNodeList
Set oAttributes = doc.getElementsByTagName("Operation")
Dim attr As MSXML2.IXMLDOMAttribute
Dim node As MSXML2.IXMLDOMElement
Dim tdate As String
tdate = Format(Now(), "yyyy-mm-dd")
For Each node In oAttributes
If (node.getAttributeNode("Client") Is Nothing) Then
node.setAttribute "Client", "UL"
End If
For Each attr In node.Attributes
If attr.Name = "Client" Then
If attr.Value <> "UL" Then
attr.Value = "UL"
End If
ElseIf attr.Name = "Date" Then
If attr.Value <> "tdate" Then
attr.Value = tdate
End If
End If
Next attr
Next node
doc.Save filePath
End If
End Sub
Also i wrote a code, that in theory should pick all .xml files in the selected folder, editing them and then save to specific folder, but it doesn't do anything-it compiles, doing something, but saves nothing. Here it is:
Sub EditXML()
Dim MyFolder As String
Dim MyFile As String
Dim oDoc As MSXML2.DOMDocument
Dim doc As New DOMDocument
On Error Resume Next
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\"
End With
MyFile = Dir(MyFolder & "*.xml")
Do While MyFile <> ""
oDoc.Load (MyFolder & MyFile)
Dim oAttributes As MSXML2.IXMLDOMNodeList
Set oAttributes = doc.getElementsByTagName("Operation")
Dim attr As MSXML2.IXMLDOMAttribute
Dim node As MSXML2.IXMLDOMElement
Dim tdate As String
tdate = Format(Now(), "yyyy-mm-dd")
For Each node In oAttributes
If (node.getAttributeNode("Client") Is Nothing) Then
node.setAttribute "Client", "UL"
End If
For Each attr In node.Attributes
If attr.Name = "Client" Then
If attr.Value <> "UL" Then
attr.Value = "UL"
End If
ElseIf attr.Name = "Date" Then
If attr.Value <> "tdate" Then
attr.Value = tdate
End If
End If
Next attr
Next node
doc.Save "D:\Test\Output\*.xml"
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
So, at conclusion, i asking for help in writing this program, because this is my first try to write something in VBA. I need parts of code, that will scaning for xml in folders and subfolders, editing them as i mentioned up here and saving the to a proper folder (depending on whether they were changed or not), as i describe in the begining and messaging about working. Here is an example of xml files with which i working:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Document>
<Operations>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06"/>
</Operations>
</Document>
Thank you very much for your help :)

Answer 1

Wow. You are trying to do A LOT of things here. Let's start with a couple items, make sure you get that working, and then build out additional features over time. For starters, you can edit all XML files in a folder in this way.
Sub ReplaceStringInFile()
Const sSearchString As String = "c:\your_path_here\*.xml"
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Dim sFilePath As String
sFileName = Dir(sSearchString)
Do While sFileName <> ""
sFilePath = "c:\temp\" & sFileName 'Get full path to file
iFileNum = FreeFile
sTemp = "" 'Clear sTemp
Open sFilePath For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
sTemp = Replace(sTemp, "THIS", "THAT")
iFileNum = FreeFile
Open sFilePath For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
sFileName = Dir() 'Get the next file
Loop
End Sub
Now, that goes into a single folder to look for XML files, but you said you want to go through all folders and all sub-folders in a directory, right, so you have a recursively loop through this 'list' of folders. You can use the code below to do that.
Sub loopAllSubFolderSelectStartDirector()
'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("C:\your_path_here\")
End Sub
'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)
Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)
While Len(fileName) <> 0
If Left(fileName, 1) <> "." Then
fullFilePath = folderPath & fileName
If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath
numFolders = numFolders + 1
Else
'Insert the actions to be performed on each file
'This example will print the full file path to the immediate window
Debug.Print folderPath & fileName
End If
End If
fileName = Dir()
Wend
For i = 0 To numFolders - 1
LoopAllSubFolders folders(i)
Next i
End Sub