使用 excel VBA 将多个 XML 文件中的相似节点复制到一个 XML

Copy similar nodes from multiple XML files to one XML using excel VBA

随着请求的不断涌入,我必须全天生成多个 xml 文件。以下是两个示例文件,它们与我生成的文件相似

示例 1

 <?xml version="1.0" encoding="UTF-8" ?>
 <BRCDATA>
   <FILENAME>BSID000001016032012001</FILENAME>
   <ENVELOPE>
     <EBRC>
       <BRCNO>BSID0000010000001001</BRCNO>
       <BRCDATE>2011-03-15</BRCDATE>
       <STATUS>F</STATUS>
       <IEC>1234567890</IEC>
       <NAME>BINAYAKTEX PROCESSORS LTD.</NAME>
       <IFSC>BSID0000010</IFSC>
       <BILLID>000000000001AM12</BILLID>
       <SNO>6995678</SNO>
       <SPORT>INBOM4</SPORT>
       <SDATE>2020-11-02</SDATE>
       <SCC>USD</SCC>
       <SVALUE>1439075.66</SVALUE>
       <RCC>USD</RCC>
       <RVALUE>1438995.66</RVALUE>
       <RDATE>2021-03-02</RDATE>
     </EBRC>
   </ENVELOPE>
 </BRCDATA>

示例 2:

 <?xml version="1.0" encoding="UTF-8" ?>
 <BRCDATA>
   <FILENAME>BSID000001016032012001</FILENAME>
   <ENVELOPE>
     <EBRC>
       <BRCNO>BSID0000010000001001</BRCNO>
       <BRCDATE>2011-03-15</BRCDATE>
       <STATUS>F</STATUS>
       <IEC>7980123456</IEC>
       <NAME>VARDHAMAN MILLS LTD.</NAME>
       <IFSC>BSID000100</IFSC>
       <BILLID>000000000001AM14</BILLID>
       <SNO>6978956</SNO>
       <SPORT>INBLR4</SPORT>
       <SDATE>2020-10-12</SDATE>
       <SCC>USD</SCC>
       <SVALUE>39055.00</SVALUE>
       <RCC>USD</RCC>
       <RVALUE>39025.00</RVALUE>
       <RDATE>2021-03-01</RDATE>
     </EBRC>
   </ENVELOPE>
 </BRCDATA>

在一天结束时,我需要将当天生成的所有此类 XML 文件中的所有 <EBRC> 节点合并到一个 XML 文件中,然后再上传在我们的系统中也是如此。喜欢下面的:

 <?xml version="1.0" encoding="UTF-8" ?>
 <BRCDATA>
   <FILENAME>BSID000001016032012001</FILENAME>
   <ENVELOPE>
     <EBRC>
       <BRCNO>BSID0000010000001001</BRCNO>
       <BRCDATE>2011-03-15</BRCDATE>
       <STATUS>F</STATUS>
       <IEC>1234567890</IEC>
       <NAME>BINAYAKTEX PROCESSORS LTD.</NAME>
       <IFSC>BSID0000010</IFSC>
       <BILLID>000000000001AM12</BILLID>
       <SNO>6995678</SNO>
       <SPORT>INBOM4</SPORT>
       <SDATE>2020-11-02</SDATE>
       <SCC>USD</SCC>
       <SVALUE>1439075.66</SVALUE>
       <RCC>USD</RCC>
       <RVALUE>1438995.66</RVALUE>
       <RDATE>2021-03-02</RDATE>
     </EBRC>
     <EBRC>
       <BRCNO>BSID0000010000001001</BRCNO>
       <BRCDATE>2011-03-15</BRCDATE>
       <STATUS>F</STATUS>
       <IEC>7980123456</IEC>
       <NAME>VARDHAMAN MILLS LTD.</NAME>
       <IFSC>BSID000100</IFSC>
       <BILLID>000000000001AM14</BILLID>
       <SNO>6978956</SNO>
       <SPORT>INBLR4</SPORT>
       <SDATE>2020-10-12</SDATE>
       <SCC>USD</SCC>
       <SVALUE>39055.00</SVALUE>
       <RCC>USD</RCC>
       <RVALUE>39025.00</RVALUE>
       <RDATE>2021-03-01</RDATE>
     </EBRC>
   </ENVELOPE>
 </BRCDATA>

我尝试在 excel VBA 中使用以下代码行,但我无法将合并的 <EBRC> 节点从多个 XML 合并到一个 xml 文件。请帮助。

   Sub OpenSeveralFiles()

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String, NewXMLFile As String
Dim i As Integer
Dim docXMLDOM As MSXML2.DOMDocument
    Dim nodRoot As IXMLDOMElement
    Dim lstVideos As IXMLDOMNodeList
    Dim lstVideos1 As IXMLDOMNodeList
Dim xmlFileName As String
Dim XML As Object, FSO As Object
    
Set FSO = CreateObject("Scripting.FileSystemObject")
Set XML = FSO.CreateTextFile(FileName:="C:\VBA Projectroom\XML MERGE\COPY1\new_combined.xml", Overwrite:=True)

Set fd = Application.FileDialog(msoFileDialogFilePicker)

'use the standard title and filters, but change the
'initial folder

fd.InitialFileName = "C:\VBA Projectroom\XML MERGE\COPY1"
fd.InitialView = msoFileDialogViewList

'allow multiple file selection

fd.AllowMultiSelect = True
FileChosen = fd.Show

If FileChosen = -1 Then

'open each of the files chosen
Set docXMLDOM = New DOMDocument

For i = 1 To fd.SelectedItems.Count

xmlFileName = fd.SelectedItems(i)
docXMLDOM.Load (xmlFileName)

Set nodRoot = docXMLDOM.DocumentElement
Set lstVideos = nodRoot.getElementsByTagName("EBRC")
    
MsgBox lstVideos(0).XML
docXMLDOM.Load "C:\VBA Projectroom\XML MERGE\COPY1\new_combined.xml"
docXMLDOM.appendChild (lstVideos(0))

Next i
End If
Set docXMLDOM = Nothing
Set XML = Nothing
Set FSO = Nothing

End Sub

谁能帮我完成代码。我无法调试代码。请帮助。 我需要 EXCEL VBA 中的 script/codes,因为 MS excel 是我们组织在办公系统上安装并允许我们在 MS [=34= 上工作的唯一程序]. 运行 Excel 允许使用宏。我们无法在不通知 IT 管理员的情况下 运行 任何其他 .exe 文件。

加载第一个文件,然后将其他 EBRC 节点附加到 ENVELOPE 节点。

Option Explicit

Sub OpenSeveralFiles()

    Const FOLDER = "C:\VBA Projectroom\XML MERGE\COPY1\"
    Const OUTFILE = "new_combined.xml"

    Dim fd As FileDialog, FSO As Object, FileChosen As Integer
    Dim xmlFileName As String
   
    Dim docOut As DOMDocument, docIn As DOMDocument
    Dim node As IXMLDOMElement, env As IXMLDOMElement
    Dim i As Integer
     
    ' select files to merge
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .InitialFileName = FOLDER
        .InitialView = msoFileDialogViewList
        .AllowMultiSelect = True
        FileChosen = fd.Show
    End With

    If FileChosen <> -1 Then
        Exit Sub
    End If
    
    Set docOut = New DOMDocument
    Set docIn = New DOMDocument

    'open each of the files chosen
    For i = 1 To fd.SelectedItems.Count
        xmlFileName = fd.SelectedItems(i)
        'Debug.Print xmlFileName

        If i = 1 Then
            ' first file load complete
            docOut.Load xmlFileName
            Set env = docOut.DocumentElement.getElementsByTagName("ENVELOPE")(0)
        Else
            ' other files append to envelope
            docIn.Load xmlFileName
            Set node = docIn.DocumentElement.getElementsByTagName("EBRC")(0)
            env.appendChild node
        End If
    Next i
    docOut.Save FOLDER & OUTFILE
    MsgBox i - 1 & " files merged to " & OUTFILE, vbInformation, "Path: " & FOLDER
    
End Sub