将多个不同结构的XML文件导入Access DB(仅部分列)

Question

我必须导入几个XML文件，但它们具有不同的结构，并且我只想从XML文件中导入某些列。

我使用这段代码导入具有相同结构的文件

Private Sub Command5_Click()
Dim strFile As String       'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer      'File Number
Dim strPath As String       ' Path to file folder

'strPath = Me![Path]
strPath = "D:XML"
strFile = Dir(strPath & "*.XML")
strFile = Dir(strPath & A)

While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend

'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If

'cycle through the list of files
For intFile = 1 To UBound(strFileList)
Application.ImportXML strPath & strFileList(intFile), 2
Next intFile

MsgBox "Import Completed"
end sub

如何修改代码以从所有XML文件导入公共列

Answer 1

这是我第二次使用Access和xml，所以可能有更好的解决方案。您可以使用MSXML库来操作xml文件。例如:

假设XML文件来自:https://www.w3schools.com/xml/cd_catalog.xml假设您想要删除美工和标题

Option Compare Database
Public Sub ImportXML()
Dim strFile As String       'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer      'File Number
Dim strPath As String       ' Path to file folder
Dim xdoc As New MSXML2.DOMDocument60  'under tools-references add reference to msxml v6 to do it this way
strPath = "C:UsersbubblegumDesktop"
strFile = Dir(strPath & "*.XML")

While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend

'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If

'cycle through the list of files
For intFile = 1 To UBound(strFileList)
xdoc.Load (strPath & strFileList(intFile)) 'load xml file
trimnode xdoc, "TITLE" 'objects passed by reference
trimnode xdoc, "ARTIST"
xdoc.Save (strPath & "temp" & strFileList(intFile))
Application.ImportXML strPath & "temp" & strFileList(intFile), 1
Kill strPath & "temp" & strFileList(intFile) 'delete temp file
Next intFile
MsgBox "Import Completed"
'clean up
Set xdoc = Nothing
End Sub
Public Sub trimnode(xmldocument As MSXML2.DOMDocument60, nodename As String)
Dim list As IXMLDOMNodeList
Dim noderoot As IXMLDOMElement
Dim parent As IXMLDOMElement
Set noderoot = xmldocument.documentElement 'get root node
Set list = noderoot.getElementsByTagName(nodename)
For Each NODE In list
Set parent = NODE.parentNode
parent.removeChild NODE
Next
End Sub

给:

-------------------------------------------------------------------------------------
|      COUNTRY       |      COMPANY       |       PRICE        |        YEAR        |
-------------------------------------------------------------------------------------
| USA                | Columbia           | 10.90              | 1985               |
-------------------------------------------------------------------------------------
| UK                 | CBS Records        | 9.90               | 1988               |
-------------------------------------------------------------------------------------
| USA                | RCA                | 9.90               | 1982               |
-------------------------------------------------------------------------------------
| UK                 | Virgin records     | 10.20              | 1990               |
-------------------------------------------------------------------------------------
| EU                 | BMG                | 9.90               | 1997               |
-------------------------------------------------------------------------------------
| UK                 | Polydor            | 10.90              | 1998               |
-------------------------------------------------------------------------------------
| UK                 | CBS                | 8.10               | 1973               |
-------------------------------------------------------------------------------------
| UK                 | Pickwick           | 8.50               | 1990               |
-------------------------------------------------------------------------------------
| EU                 | Polydor            | 10.80              | 1996               |
-------------------------------------------------------------------------------------
| USA                | Atlantic           | 8.70               | 1987               |
-------------------------------------------------------------------------------------
| EU                 | Mega               | 10.90              | 1995               |
-------------------------------------------------------------------------------------
| USA                | Grammy             | 10.20              | 1999               |
-------------------------------------------------------------------------------------
| UK                 | Mucik Master       | 8.70               | 1995               |
-------------------------------------------------------------------------------------
| USA                | Columbia           | 9.90               | 1997               |
-------------------------------------------------------------------------------------
| UK                 | Polydor            | 8.20               | 1971               |
-------------------------------------------------------------------------------------
| Norway             | WEA                | 7.90               | 1996               |
-------------------------------------------------------------------------------------
| UK                 | Island             | 8.90               | 1990               |
-------------------------------------------------------------------------------------
| UK                 | A and M            | 8.90               | 1988               |
-------------------------------------------------------------------------------------
| UK                 | Siren              | 7.90               | 1987               |
-------------------------------------------------------------------------------------
| UK                 | Capitol            | 8.90               | 1983               |
-------------------------------------------------------------------------------------
| EU                 | Medley             | 7.80               | 1983               |
|
-------------------------------------------------------------------------------------

最有用的链接:https://www.functionx.com/vbaccess/Lesson63.htm