如何使用 Excel VBA 从子文件夹加载所有 XML 文件？

Question

目前我正在使用 Excel VBA 代码将特定节点从 XML 文件导入 Excel 电子表格。这些文件按天存储到单独的文件夹中。一旦工作完成，通常在 20 多天后，我使用下面的 VBA 代码从子文件夹中获取所有文件：

Private Sub Create_Heading()
    ' This subroutine creates the necessary headings in the specified cells.

    Range("A1").Value = "Bead No."
    Range("B1").Value = "Duration (s)"
    Range("C1").Value = "Log #"
    Range("D1").Value = "Sched. ID"
    Range("E1").Value = "System ID"

    Range("A1:E1").WrapText = True
    Range("A1:A2").Merge
    Range("B1:B2").Merge
    Range("C1:C2").Merge
    Range("D1:D2").Merge
    Range("E1:E2").Merge


    Range("F2").Value = "Peak Current"
    Range("G2").Value = "Back Current"
    Range("H2").Value = "Peak Voltage"
    Range("I2").Value = "Back Voltage"
    Range("J2").Value = "Peak Travel Speed"
    Range("K2").Value = "Back Travel Speed"
    Range("L2").Value = "Peak Wire Speed"
    Range("M2").Value = "Back Wire Speed"

    Range("F1:M1").Merge
    Range("F1").Value = "Set"

    Range("N2").Value = "Peak Current"
    Range("O2").Value = "Back Current"
    Range("P2").Value = "Peak Voltage"
    Range("Q2").Value = "Back Voltage"
    Range("R2").Value = "Peak Travel Speed"
    Range("S2").Value = "Back Travel Speed"
    Range("T2").Value = "Peak Wire Speed"
    Range("U2").Value = "Back Wire Speed"

    Range("N1:U1").Merge
    Range("N1").Value = "Actual"

    Range("V2").Value = "Date (DD/MM/YY)"
    Range("W2").Value = "Start (hh:mm:ss)"
    Range("X2").Value = "End (hh:mm:ss)"
    Range("Y2").Value = "Duration (hh:mm:ss)"
    Range("Z2").Value = "Waiting Time (hh:mm:ss)"

    Range("V1:Z1").Merge
    Range("V1").Value = "Timeline"


    Range("A1:Z2").HorizontalAlignment = xlCenter
    Range("A1:Z2").VerticalAlignment = xlCenter
    Range("A1:Z2").Font.Bold = True

    Range("A1").ColumnWidth = 5
    Range("B1:E1").ColumnWidth = 8
    Range("F1:U1").ColumnWidth = 9
    Range("V1:Z1").ColumnWidth = 14

    Range("F2:Z2").WrapText = True

    ActiveSheet.Columns("V").NumberFormat = "dd/mm/yy"
    ActiveSheet.Columns("W").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("X").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("Y").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("Z").NumberFormat = "hh:mm:ss"

End Sub


Sub XMLProcessing_rev0()
    Dim StrFile As String
    Dim Address As String
    Dim i As Integer
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Application.StatusBar = "Initializing..."

    ' Check if heading area is empty, if so create headings.
    If WorksheetFunction.CountA(Range("A1:Z2")) = 0 Then
        Create_Heading
    End If

    ' Prompt user to enter the file location
    Address = InputBox("Enter folder location of data files:", "Welding Parameter XML Processing") & "\"
    ' Macro will look for files that satisfy the path: "UserAddress\LOG*"  i.e. LOG____.xml files
    StrFile = dir(Address & "LOG*")

    i = 0
    ' This loop runs for every file in the folder
    Do While Len(StrFile) > 0
        Application.StatusBar = "Copying row " & i + 1 & "."

        ' Load the XML document
        xmlDoc.Load (Address & StrFile)

        ' Set values in worksheet to data found in XML

        Cells(3 + i, 1).Value = xmlDoc.SelectSingleNode("//log").getAttribute("weld")
        Cells(3 + i, 2).Value = xmlDoc.SelectSingleNode("//data/totaltime").Text
        Cells(3 + i, 3).Value = xmlDoc.SelectSingleNode("//log").getAttribute("number")
        Cells(3 + i, 4).Value = xmlDoc.SelectSingleNode("//sched").getAttribute("id")
        Cells(3 + i, 5).Value = xmlDoc.SelectSingleNode("//log").getAttribute("sn")

        Cells(3 + i, 6).Value = xmlDoc.SelectSingleNode("//seg/priamp").Text
        Cells(3 + i, 7).Value = xmlDoc.SelectSingleNode("//seg/bkgamp").Text
        Cells(3 + i, 8).Value = xmlDoc.SelectSingleNode("//seg/privolt").Text
        Cells(3 + i, 9).Value = xmlDoc.SelectSingleNode("//seg/bkgvolt").Text
        Cells(3 + i, 10).Value = xmlDoc.SelectSingleNode("//seg/pritrav").Text
        Cells(3 + i, 11).Value = xmlDoc.SelectSingleNode("//seg/bkgtrav").Text
        Cells(3 + i, 12).Value = xmlDoc.SelectSingleNode("//seg/priwire").Text
        Cells(3 + i, 13).Value = xmlDoc.SelectSingleNode("//seg/bkgwire").Text

        Cells(3 + i, 14).Value = xmlDoc.SelectSingleNode("//data/avg/priamp").Text
        Cells(3 + i, 15).Value = xmlDoc.SelectSingleNode("//data/avg/bkgamp").Text
        Cells(3 + i, 16).Value = xmlDoc.SelectSingleNode("//data/avg/privolt").Text
        Cells(3 + i, 17).Value = xmlDoc.SelectSingleNode("//data/avg/bkgvolt").Text
        Cells(3 + i, 18).Value = xmlDoc.SelectSingleNode("//data/avg/pritrav").Text
        Cells(3 + i, 19).Value = xmlDoc.SelectSingleNode("//data/avg/bkgtrav").Text
        Cells(3 + i, 20).Value = xmlDoc.SelectSingleNode("//data/avg/priwire").Text
        Cells(3 + i, 21).Value = xmlDoc.SelectSingleNode("//data/avg/bkgwire").Text

        Cells(3 + i, 22).Value = xmlDoc.SelectSingleNode("//log/time/day").Text & "/" & xmlDoc.SelectSingleNode("//log/time/mo").Text & "/" & xmlDoc.SelectSingleNode("//log/time/yr").Text
        Cells(3 + i, 23).Value = xmlDoc.SelectSingleNode("//log/time/hr").Text & ":" & xmlDoc.SelectSingleNode("//log/time/min").Text & ":" & xmlDoc.SelectSingleNode("//log/time/sec").Text
        Cells(3 + i, 24).Value = Cells(3 + i, 23).Value + (Cells(3 + i, 2).Value / 86400)
        Cells(3 + i, 25).Value = Cells(3 + i, 24).Value - Cells(3 + i, 23).Value


        ' Center all cells in the row b/c formatting is nice
        Range(Cells(3 + i, 1), Cells(3 + i, 26)).HorizontalAlignment = xlCenter

        ' Don't remember what this is for, but it probably resets the StrFile _
        variable to what it was before the loop
        StrFile = dir
        i = i + 1
    Loop

    ' Reset status bar
    Application.StatusBar = False
End Sub

因为每天的日志都以顺序名称开头，即 LOG0001、LOG0002、LOG0003 等。我不能将所有文件复制到一个文件夹中然后运行宏。我想修改下面的代码，如果我只指定主文件夹“root”，我将能够从子文件夹加载文件。

如果您能给我任何帮助，我将不胜感激。

Answer 1

  Your code gets the fist file in the main folder with

    StrFile = dir(Address & "LOG*")


  and then loops through, filling the variable with the next filename using

   StrFile = dir() 

（如果您使用不带参数的 dir，它将返回您上次使用的模式中的下一个文件。）

您需要做的是创建一个外部循环来搜索子目录，然后为每个子目录修改您的地址变量并重新运行您的代码。所以

    Dim subdir as string

    subdir = Dir(address,vbDirectory)
    do until len(subdir)=0
        StrFile = Dir(Address & "\" & subdir & "\LOG*")

        Do While Len(StrFile) > 0  
                'your existing code here

         StrFile = Dir()
        Loop
         SubDir = Dir()
     loop