如何在 Excel 中使用 VBA 导入 XML 文件名和数据？

Question

我一直在研究 VBA 宏脚本来帮助导入和组织 XML 与用户请求相关的文件。但是，现在我正在尝试添加文件名，因为它包含发送特定 XML 文件的用户的姓名。我设法制定了一个代码来导入 XML 并在每个 XML 导入的末尾添加文件名，但现在我想导入文件名和数据（如末尾的每一行柱子）。如图所示，XXX 表示 XML 数据：

XXX1    XXX1  filename1  
XXX1    XXX1  filename1  
XXX1    XXX1  filename1  
XXX2    XXX2  filename2  
XXX2    XXX2  filename2  
XXX2    XXX2  filename2

现在我的代码看起来像这样

Option Explicit

Sub LoopThroughFiles()

    Dim strFile As String, strPath As String, Num As Long, LR As Integer

    strPath = "C:\Requests\"
    strFile = Dir(strPath & "*.xml")
    Num = 0

    While strFile <> ""

        ActiveWorkbook.XmlMaps("resources_Map").Import Url:= _
        (strPath & strFile)

        strFile = Dir

        Num = Num + 1

        LR = Cells(Rows.Count, "A").End(xlUp).Row
        LR = LR + 1
        Cells(LR, "A") = strFile

    Wend

MsgBox "This code ran successfully for " & Num & " XML file(s)", vbInformation

End Sub

当前代码如下：

XXX1 XXX1  
filename1  
XXX2  XXX2  
filename2

添加一列看起来很简单，但我不确定如何向 XML 导入中的所有行添加值。提前致谢！

Answer 1

使用Range 方法更新文件名。变量 lngStart 和 lngEnd 将具有开始和结束行号。

Option Explicit

Sub LoopThroughFiles()
    Dim strFile As String, strPath As String, Num As Long, LR As Integer
    Dim lngStart, lngEnd As Long

    strPath = "C:\Requests\"
    strFile = Dir(strPath & "*.xml")
    Num = 0

    lngStart = 2 'considering row 1 has headers. if not change it to 1.
    While strFile <> ""

        ActiveWorkbook.XmlMaps("resources_Map").Import URL:= _
        (strPath & strFile)

        strFile = Dir

        Num = Num + 1

        lngEnd = Cells(Rows.Count, "A").End(xlUp).Row
        Range("B" & lngStart & ":B" & lngEnd).Value = strFile

        lngStart = lngEnd + 1

    Wend

MsgBox "This code ran successfully for " & Num & " XML file(s)", vbInformation

End Sub

Answer 2

您可以使用一个函数来检索文件名并添加：

Option Explicit
Public Sub AddFileNames()
    Dim destinationCell As Range, results() As String
    Set destinationCell = ActiveSheet.Range("A1")  '<==Set to first cell where you want to add the names from
    results = GetXMLFileNames("C:\Requests\*.xml")
    If results(UBound(results)) <> vbNullString Then
        destinationCell.Resize(UBound(results) + 1, 1) = Application.WorksheetFunction.Transpose(results)
    End If
End Sub

Public Function GetXMLFileNames(ByVal folderPath As String) As Variant
    Dim f As String, names() As String, counter As Long
    ReDim names(0 To 1000)
    f = Dir(folderPath)
    Do Until f = vbNullString
        names(counter) = f
        f = Dir
        counter = counter + 1
    Loop
    ReDim Preserve names(0 To counter - 1)
    GetXMLFileNames = names
End Function

如何在 Excel 中使用 VBA 导入 XML 文件名和数据？

How do I import XML file names along with the data using VBA in Excel?

xml

import

excel

filenames

vba