从 XML 文档获取文件信息并添加到 Excel答案

【问题标题】：Get file information from XML docs and add to Excel从 XML 文档获取文件信息并添加到 Excel
【发布时间】：2016-12-11 20:18:47
【问题描述】：

我有一个用户放入 XML 文档的投递箱文件。我想为以下流程编写代码：

第 1 部分：获取文件数

我想要一个 Excel 表格，显示每行中按日期排序的文件数

第 2 部分：检查 XML

检查特定代码行的 1 或 0 的内部 xml 部分

第 3 部分：动态更新 excel 文档

每次打开 excel 文档并检查子文件夹时，如果找到上次修改的新日期，则会在 1 和 2 中添加新行。

我在 excel 文档中有 5 列，第一行是工作表上的标签，如下所示：

A列有日期

列 B 包含文件夹 1 中的第 1 部分

列 C 有 1+2 部分，xml 代码为 0

列 D 有部分 1+2，其中 xml 代码是文件夹 2 中的 1

列 E 包含文件夹 3 中的第 1 部分

我非常了解 javascript，但我从未在 Quickbase 之外使用过它。我什至如何开始进行此设置？

编辑 1：

为了澄清，文件夹树看起来像这样

../Dropbox/SharedWorkFolder/APIReports/auditreports.xlsm
../Dropbox/SharedWorkFolder/APIReports/OrderLog/(xmls for column A+C+D)(roughly 2k files)
../Dropbox/SharedWorkFolder/APIReports/PandA/(xmls for column A+B)(11k files)
../Dropbox/SharedWorkFolder/APIReports/SpecificLookup/(xmls for column A+E)(130 files)

到目前为止，我一直在阅读 excel 的文档，但我发现我对它的多样性缺乏了解。

到目前为止，我已经设法自己导入文件内容，但是由于它们的长度和 xml 内容非常长，我需要特定的 xml 标签，遗憾的是，除了文件名之外，它们没有日期，并且在导入时它们似乎已经单独分组每个文件也是如此。

文件名看起来像这样1452521833783-110120160917SS110313 表示第一个字符串是交易号，然后是日期+时间“SS”和一些 6 个数字字符串。

我将继续阅读有关 excel VBA 的文档并测试一些东西

编辑 2：

我找到了这个代码“Excel VBA using FileSystemObject to list file last date modified”，但它一直给我一个错误，用户定义类型未定义。

编辑 3：到目前为止，我可以使用此代码

Dim iRow

Sub ListFiles()
    iRow = 11
    Call ListMyFiles(Range("C7"), Range("C8"))
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        iCol = 2
        Cells(iRow, iCol).Value = myFile.Path
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Name
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Size
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.DateLastModified
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub

我仍然需要遍历所有 XML 并获取特定节点，哦，地图有问题，因为 XML 没有分配给它们的地图，而且它们都有不同数量的节点（但我需要 1 系列重复出现)。

【问题讨论】：

标签： xml excel vba

【解决方案1】：

虽然你也许可以使用 Javascript 来做到这一点（我不熟悉 Excel 与 js 的集成），但我的第一直觉是通过 VBA 来做到这一点：所以在我继续之前，你有什么理由特别想要 js还是 VBA 解决方案可以解决问题？我会相应地编辑这个答案。

【讨论】：

欢迎来到 StackOverflow！请不要使用答案作为询问有关该问题的更多信息的方式。您应该改用 cmets。（您需要先获得足够的声誉才能发表评论）
对不起。如果没有必要的积分，我该如何贡献？
您可以去寻找可以回答的问题，而无需询问更多信息。如果您的答案被接受/赞成，您将获得声誉，并且您也将很快被允许发表评论。我们都去过那里；）有关如何获得声誉的更多信息，请参阅：stackoverflow.com/help/whats-reputation
简单地说我不懂VBA
因此，在上周研究 VBA 并测试了一些东西之后，我认为 VBA 可能是一条更好的路线，但我遇到了一些问题，也许你可以帮助我完成。我将添加到我的原始帖子以获取更多详细信息和房间

【解决方案2】：

（代表 OP 发布）.

经过多次戳戳，这是我的最终编辑，什么做什么；每个部分都由按钮完成：

../Dropbox/SharedWorkFolder/APIReports/auditreports.xlsm
../Dropbox/SharedWorkFolder/APIReports/OrderLog/(xmls for column A+C+D)(roughly 2k files)
../Dropbox/SharedWorkFolder/APIReports/PandA/(xmls for column A+B)(11k files)
../Dropbox/SharedWorkFolder/APIReports/SpecificLookup/(xmls for column A+E)(130 files)

关键单元格是：

C7: 有完整的目录名来获取信息
C8：是否有子文件夹的布尔值
A9:=REPLACE(B9,1,SEARCH("^",SUBSTITUTE(B9,"\","^",LEN(B9)-LEN(SUBSTITUTE(B9,"\",""))-1)),"")
F9:=SUBSTITUTE(SUBSTITUTE(A9,C9,""),"\","") 用于另一个表的最后一个文件夹的名称
G9:=IF(H9,LEFT(C9,13),"") 文件名中的事务 id 编号，用于将 xml 数据链接到所有表
H9:=IF(RIGHT(C9,3)="xml",TRUE,FALSE) 甚至认为我不再需要这个专栏了
I9:=IF(Table4[@FolderName]="OrderLog",TRUE,FALSE) 获取仅用于 xml 解析的订单日志文件

所有这一切背后的逻辑是将文件夹中的所有 XML 文件放到一个列表中，然后从特定文件夹名称导入 XML 数据。

我的模块：

Dim iRow
Dim iTar


Sub ListFiles()
    iRow = 11
    Call ListMyFiles(Range("C7"), Range("C8"))
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        iCol = 2
        Cells(iRow, iCol).Value = myFile.Path
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Name
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Size
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.DateLastModified
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub

Sub filldown()

    Range("A9").Select
    Selection.Copy
    Range("A11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F9").Select
    Selection.Copy
    Range("F11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G9").Select
    Selection.Copy
    Range("G11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H9").Select
    Selection.Copy
    Range("H11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("I9").Select
    Selection.Copy
    Range("I11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select

End Sub


Sub ClearTable1()

    With Sheet1.ListObjects("Table4").ListRows
        Do While .Count >= 1
            .Item(1).Delete
        Loop
    End With
End Sub

Sub ClearTable2()

    With Sheet1.ListObjects("Table2").ListRows
        Do While .Count >= 1
            .Item(1).Delete
        Loop
    End With

End Sub



Sub XmlImport()
    Dim xmpCustomMap As XmlMap
    Set xmpCustomMap = ActiveWorkbook.XmlMaps("OrderLogDataSet_Map")
    Dim x As String
    Dim iPath As String
    Range("B11").Select
    x = "True"
    For i = 1 To Range("Table4").Rows.Count
          iPath = Worksheets("DATA").Cells(i + 10, 2).Value
          iTar = Worksheets("DATA").Cells(i + 10, 9).Value
          If iTar = x Then
           ActiveWorkbook.XmlImport URL:=iPath, ImportMap:=xmpCustomMap, Overwrite:=False
           End If
        ActiveCell.Offset(1, 0).Select
        Next i
End Sub

【讨论】：