Pfthb

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:TestOutput*.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 :)

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