Программа, оптимизирующая процесс работы с XML-файлами

Question

Извините за мой плохой английский :( У меня есть задача - я должен написать программу в Excel VBA, которая найдет в папке и подпапках все XML-файлы, отсканирует их и внесет изменения, если это будет необходимо. Затем программа сохранит все измененные файлы в папке с именем «Сегодняшний день_мененные» и все неизмененные файлы просто переносятся в папку с именем «Сегодняшний день». В конце программа должна отобразить сообщение о том, сколько файлов было изменено и не изменено. уже написал код, который изменил .xml файл в надлежащем состоянии. Вот он:

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

Также я написал код, который теоретически должен выбрать все XML-файлы в выбранной папке, отредактировать их и затем сохранить в определенной папке, но он ничего не делает - он компилирует, делает что-то, но ничего не сохраняет. Вот оно:

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

Итак, в заключение я прошу помощи в написании этой программы, потому что это моя первая попытка написать что-то в VBA. Мне нужны части кода, которые будут сканировать XML в папках и подпапках, редактировать их, как я упоминал здесь, и сохранять в нужную папку (в зависимости от того, были ли они изменены или нет), как я описал в начале и в сообщениях о за работой. Вот пример XML-файлов, с которыми я работаю:

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

Большое спасибо за вашу помощь :)

Answer 1

Ничего себе. Вы пытаетесь сделать много вещей здесь. Давайте начнем с пары пунктов, убедитесь, что вы работаете, а затем со временем создадите дополнительные функции. Для начала вы можете редактировать все XML-файлы в папке следующим образом.

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

Теперь, это идет в одну папку для поиска файлов XML, но вы сказали, что хотите просмотреть все папки и все подпапки в каталоге, верно, поэтому у вас есть рекурсивный цикл по этому «списку» папки. Вы можете использовать код ниже, чтобы сделать это.

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