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

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

1 个答案: