从多个 XML 个文件中自动读取数据

Question

一段时间以来，我一直在尝试改进我的代码，但我无法靠自己取得进一步的进步。

我有一个通过按下按钮执行的功能。事实上，它只适用于一个文件。

在最好的情况下，我可以单击一个文件夹，该函数将遍历子文件夹并读取所有子文件夹中的所有 XML 文件，然后在 table.

如果我可以从子文件夹 中读取多个XML 文件而不只是一个文件，这将对我有所帮助。也许那时我可以更进一步，自己把另一部分弄好。

到目前为止，这是我的代码：

Private Sub CommandButtonImport_Click()
    Dim fd As Office.FileDialog                     
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Title = "Select a XML File"
        .AllowMultiSelect = True             
            
        If .Show = True Then
            xmlFileName = .SelectedItems(1)

            Dim xDoc As Object
            Set xDoc = CreateObject("MSXML2.DOMDocument")
            xDoc.async = False: xDoc.ValidateOnParse = False
            xDoc.Load (xmlFileName)

            Set Products = xDoc.DocumentElement
            row_number = 1
            
            Rows("11:11").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            
            For Each Product In Products.ChildNodes
                Range("C11").Value = Products.ChildNodes(0).ChildNodes(0).Attributes.Item(21).Value
                Range("F11").Value = Products.ChildNodes(0).ChildNodes(0).Attributes.Item(0).Value
                Range("G11").Value = Products.ChildNodes(0).ChildNodes(0).ChildNodes(1).ChildNodes(0).Attributes.Item(1).Value
                Range("C:C").Columns.AutoFit 
    
                row_number = row_number + 1
            Next Product            
        End If
    End With
    
    Add_Row_Number
End Sub

我不确定，但这可能有帮助

任何意见都可以提供帮助，我将非常感谢提前致谢 RomanWASD

Answer 1

以递归方式使用 getFolder method of a FileSystemObject to create a folder object. Then use Subfolders property and Files 属性。

Option Explicit

Private Sub CommandButtonImport_Click()
    
    Dim fd As Office.FileDialog, folder As String, n As Long
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Filters.Clear
        .Title = "Select a Folder"
        .AllowMultiSelect = True
            
        If .Show = True Then
            folder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Dim fso As Object, ws As Worksheet, t0 As Single: t0 = Timer
    Set ws = ActiveSheet ' or better as Thisworkbook.Sheets("Name")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' recurse down folder tree
    n = n + ScanFolder(ws, fso.GetFolder(folder))
    ws.Range("C:C").Columns.AutoFit
    MsgBox n & " files scanned", vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub

Function ScanFolder(ws As Worksheet, folder As Object) As Long
    
    Dim subfolder As Object, file As Object, n As Long
    For Each subfolder In folder.SubFolders
        n = n + ScanFolder(ws, subfolder) ' recurse
    Next
   
    For Each file In folder.Files
        If file.Type = "XML Document" Then
            ParseFile ws, file
            n = n + 1
        End If
    Next
    ScanFolder = n ' number of files
    
End Function

Function ParseFile(ws As Worksheet, file As Object)

    Dim xDoc As Object, Products As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    
    With xDoc
        .async = False
        .ValidateOnParse = False
        .Load file.Path 'folder and filename
        Set Products = .DocumentElement
    End With
    
    If Products Is Nothing Then
    Else
        ws.Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
        With Products.ChildNodes(0).ChildNodes(0)
            ws.Range("C11").Value = .Attributes(21).NodeValue
            ws.Range("F11").Value = .Attributes(0).NodeValue
            ws.Range("G11").Value = .ChildNodes(1).ChildNodes(0).Attributes(1).NodeValue
        End With
    End If

End Function

Answer 2

我最近在处理类似的问题。我尝试过的最快的解决方案是在 VBA 中使用 import XML，将其导入为 table 并将 table 加载到数组中。

Sub xmlintoarray()
Dim FSO As Object
Dim FSOfile As Object
Dim wb As Workbook
Dim path As String

path = "C:\Documents\Studypool"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOfile = FSO.GetFolder(path)
Set FSOfile = FSOfile.Files
Set wb = ThisWorkbook
For Each FSOfile In FSOfile

wb.Sheets.Add.Name = FSOfile.Name

wb.XmlImport FSOfile.path, Importmap:=Nothing, overwrite:=True, _
Destination:=ThisWorkbook.Sheets(FSOfile.Name).Range("$A")

Next

'here insert code to merge tables
'create array from merged table
'or create merge arrays together.

End Sub

从多个 XML 个文件中自动读取数据

Automation of reading data from multiple XML files

xml

excel

automation

vba

loops