创建 DOMDocument 集合

Creating a collection of DOMDocument

我有一个宏,其中用户应该 select .xml 个文件夹中的文件,文件的数量未确定。

在那些.xml中,有两个节点类别:

加载我的 .xml 文件后,我必须:

我的问题是加载每个 selected 文件并将其存储为 DOMDocument。我在考虑使用集合或数组,但都不起作用,因为对象是通过 Byref 传递的,我最终得到了一个存储 x 次最后一次加载的集合。xml。

我(真的)想做的事:

我不能做或尽量避免的事情:

我在 Whosebug 和 google 上搜索了各种关键字,但似乎找不到解决方案。

"Microsoft XML, v6.0" 库已添加到我的库引用中。

Dim xmlDoc as DOMDocument
Dim SelFiles As FileDialogSelectedItems
Dim nFile as long
Dim coDocXML As New Collection

Set SelFiles = InputFilesDial("xml", "*.xml", True)

For nFile = 1 to SelFiles.Count
    If xmlDoc.Load(SelFiles(nFile)) Then
        coDocXML.Add Item:=xmlDoc
    End If
Next nFile

Function InputFilesDial(stDescription As String, stFilter, multiSel As Boolean, Optional stPath As String) As FileDialogSelectedItems

    Dim FileDial As Office.FileDialog
    If Not stPath Like vbNullString Then ChDir (stPath)

    Set FileDial = Application.FileDialog(msoFileDialogFilePicker)

    With FileDial
        .AllowMultiSelect = multiSel
        .Filters.Clear
        .Filters.Add Description:=stDescription, Extensions:=stFilter
        .Show
    End With

    Set InputFilesDial = FileDial.SelectedItems

End Function

试试这个允许多选的方法。添加到 collection 后,您可以通过 xDoc1xDoc2 ...:[=​​13=] 引用您的 XML 文件

代码

Option Explicit
  Dim coDocXML As New Collection
' Declare xDoc variable as of type DOMDocument60
  Dim xDoc As MSXML2.DOMDocument60 

Sub test_xmlcol()
'  Declare a variable to contain the path of each selected item. 
'  Even though the path is aString, the variable must be a Variant because 
'  For Each...Next routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
dim cnt   As Integer
'Declare a variable as a FileDialog object.
Dim cnt   As Integer
Dim fd    As FileDialog
'Create a FileDialog object as a File Picker dialog box.
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
' Set xDoc to memory
  Set xDoc = New MSXML2.DOMDocument60               
  xDoc.validateOnParse = False
' allow XPath (if DOMDocument vers. 3.0, can omit it if vers. 6.0)
  xDoc.setProperty "SelectionLanguage", "XPath"


'Use a With...End With block to reference the FileDialog object.
With fd

    'Allow the selection of multiple file.
    .AllowMultiSelect = True
    'Add a filter that includes GIF and JPEG images and make it the first item in the list.
     .Filters.Add "XML-Files", "*.xml", 1
    'Use the Show method to display the File Picker dialog box and return the user's action.
    'The user pressed the button.
    If .Show = -1 Then

          'Step through each string in the FileDialogSelectedItems collection
          For Each vrtSelectedItem In .SelectedItems
            cnt = cnt + 1
            'vrtSelectedItem is aString that contains the path of each selected item.
            'You can use any file I/O functions that you want to work with this path.
            'This example displays the path in a message box.
            MsgBox "Selected item's path: " & vrtSelectedItem
            coDocXML.Add vrtSelectedItem, "xDoc" & cnt
          Next vrtSelectedItem

    'The user pressed Cancel.
    Else
    End If
End With

' Have an informative look at every file    
For cnt = 1 To coDocXML.Count
   Debug.Print cnt, "xDoc" & cnt & ": " & coDocXML.Item("xDoc" & cnt)
Next cnt

'' load some file and do something via 
'    cnt = 1           ' only example
'    If xDoc.Load coDocXML.Item("xDoc" & cnt) then
''      ... do something
'    End If

'Set the object variable to Nothing.
Set fd = Nothing

End Sub

只需在循环中重置 xmlDoc 对象并为解析失败的文件添加 Else 处理程序。 Debug.Print window (Ctrl + G) 中的项目将输出引发解析错误的文件:

Sub RunXML()
    Dim xmlDoc As DOMDocument
    Dim SelFiles As FileDialogSelectedItems
    Dim nFile As Long
    Dim coDocXML As New Collection

    Set SelFiles = InputFilesDial("xml", "*.xml", True)

    For nFile = 1 To SelFiles.Count
        Set xmlDoc = New DOMDocument             ' RESET xmlDoc OBJECT

        If xmlDoc.Load(SelFiles(nFile)) Then
            coDocXML.Add Item:=xmlDoc
        Else
            Debug.Print SelFiles(nFile), xmlDoc.parseError
        End If
    Next nFile

    Set SelFiles = Nothing
    Set xmlDoc = Nothing
End Sub