需要使用 Excel vba 合并两个 xml 文件答案

【问题标题】：Need to merge two xml files using Excel vba需要使用 Excel vba 合并两个 xml 文件
【发布时间】：2019-11-29 22:33:51
【问题描述】：

我需要在 Excel VBA 中合并两个 XML 文件。第二个 XML 文件应作为第一个 XML 的同级添加。合并 XML 文件后还必须创建一个Union。例如：

第一个 XML 文件：

<TupleList>
    <Member FullPath="Latest : FOLDER Day Ending 06-16-2019"/>
</TupleList>

第二个 XML 文件：

 <TupleList>
   <Member FullPath="Latest : FOLDER Day Ending 06-17-2019"/>
 </TupleList>

预期的输出 XML 文件：

 <Union>
  <TupleList>
    <Member FullPath="Latest : FOLDER Day Ending 06-16-2019"/>
  </TupleList>
  <TupleList>
   <Member FullPath="Latest : FOLDER Day Ending 06-17-2019"/>
  </TupleList>
 </Union>

我尝试了下面的代码，但它没有按预期工作

  Set XOuter = CreateObject("MSXML2.DOMDocument")
  Set XOuter1 = CreateObject("MSXML2.DOMDocument")
  Dim appendNode As MSXML2.IXMLDOMNode
  XOuter.Load ("C:\\blp\\1stXML.xml")
  XOuter1.Load ("C:\\blp\\2ndXML.xml")
  For Each appendNode In XOuter1.DocumentElement.ChildNodes
     XOuter.DocumentElement.appendChild appendNode
  Next

它以 Tuplelist 作为父级和 2 个成员作为子级提供输出。但我想要以高于预期的格式输出。

【问题讨论】：

有效的 XML 有一个根元素 - 这似乎是您预期输出的问题。
知道了。然后我可以在元组列表之前创建一个标签Union。更新了预期的输出

标签： excel xml vba xpath

【解决方案1】：

如果您有很多文件，您可以将它们放在一个文件夹中，然后使用 cmd 将它们组合成一个文件（假设它们没有根节点）。然后使用 fileSystemObject 添加根节点。我决定使用现有文档，尽管我考虑过使用 .appendChild 和 .createElement 来添加带有附加文档变量的根节点。我想我可能更喜欢那个。

Option Explicit

Public Sub CombineFiles()
    Dim cmd As String, fso As Object, xmlDoc As Object, numberOfFilesInFolder As Long, folder As Object
    Const FOLDER_PATH As String = "C:\Users\User\Desktop\XML Test"
    Const COMBINED_FILE_PATH As String = "C:\Users\User\Desktop\XML Test\Combined.xml"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(FOLDER_PATH)

    numberOfFilesInFolder = folder.Files.Count
    cmd = "cmd /c cd """ & folder & """ && copy *.xml Combined.xml"

    Shell cmd, vbNormalFocus

    Do
        DoEvents
    Loop Until folder.Files.Count = numberOfFilesInFolder + 1

    AddRootNode COMBINED_FILE_PATH, fso
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")

    With xmlDoc
        .validateOnParse = True
        .setProperty "SelectionLanguage", "XPath"
        .async = False
        If Not .Load(COMBINED_FILE_PATH) Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
            Exit Sub
        End If
    End With
End Sub
Public Sub AddRootNode(ByVal filepath As String, fso As Object)
    Const READING = 1
    Const WRITING = 2
    Dim file As Object, contents As String

    Set file = fso.OpenTextFile(filepath, READING)

    contents = file.ReadAll
    file.Close
    contents = "<Union>" & vbCrLf & Replace$(contents, Chr$(26), vbNullString) & vbCrLf & "</Union>"
    Set file = fso.OpenTextFile(filepath, WRITING, True)
    file.Write contents
    file.Close
End Sub

参考资料：

【讨论】：

@YasserKhalil 尝试在此之前添加一个短暂的延迟。
文件底部有空行吗？还是空文件？ docs.microsoft.com/en-us/office/vba/language/reference/…
那么两个文件，每个文件都有不同的 xml？在正确的文件夹中？
不。尝试使用 F8 单步执行
非常感谢。现在解决了，我试了几次。 ` Application.Wait Now + TimeValue("00:00:03") AddRootNode COMBINED_FILE_PATH, fso `

【解决方案2】：

这对我有用：

Dim inDoc As New MSXML2.DOMDocument60
Dim resultDoc As New MSXML2.DOMDocument60
Dim rt As Object, nd

Set rt = resultDoc.appendChild(resultDoc.createElement("Union"))

Debug.Print resultDoc.XML

''using loadXML here for convenience...
inDoc.LoadXML ("<TupleList><Member FullPath=""Latest : FOLDER Day Ending 06-16-2019""/></TupleList>")
Set nd = resultDoc.importNode(inDoc.DocumentElement, True)
rt.appendChild nd

inDoc.LoadXML ("<TupleList><Member FullPath=""Latest : FOLDER Day Ending 06-17-2019""/></TupleList>")
Set nd = resultDoc.importNode(inDoc.DocumentElement, True)
rt.appendChild nd

Debug.Print resultDoc.XML

【讨论】：