程序，优化处理 XML 文件的过程

Question

对不起我的英语不好:(我有一个任务 - 我应该在 Excel VBA 中编写一个程序，它将在文件夹和子文件夹中找到所有 .xml 文件，扫描它们并在必要时进行更改。然后程序将保存所有更改了名为“Todays date_changed”的文件夹中的文件，所有未更改的文件只传输到名为“Today date”的文件夹。最后程序应显示有关已更改和未更改的文件数量的消息。我已经已经编写了代码，在适当的条件下更改了 .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