使用SQL和VB6将XML数据导入MS Access表

Question

我有一个XML文件，其中很多记录都位于“ / response / result / record”下。 例如：

<response>
  <result>
    <record>
      <flda>some text</flda>
      <fldb>some text</fldb>
      :     :     :
    </record>
    :    :    :
  </result>
</response>

我有一个MSAccess数据库和一个旧版VB6程序，需要读取该文件并将其加载到包含每个记录中每个文本节点字段的表中。

我知道我可以使用MSXML2.DOMDocument从Internet加载XML并将其保存到文件中。 然后，我还可以使用DOMDocument读取XML并一次将一条记录加载到MSAccess数据库表中。

这似乎效率很低，因为我可以使用VB6语法将CSV文件加载到MSAccess表中，例如：

db.Execute "Select * Into CSVtable From [Text;FMT=CSVDelimited;HDR=YES;DATABASE=dirPath].[filename]"

并且它将迅速将该数据批量加载到数据库中。 比从CSV文件中读取每条记录并使用DAO记录集一次添加每条记录要快得多。

我的问题 ：我可以对XML文件做同样的事情吗？ 语法是什么，我该怎么做？

后续问题 ：在哪里可以找到上面显示的CSV文件（最初在StackOverflow上找到的）这种“ Select ...”语法的文档？

Answer 1

据我所知，仅在JETSQL40.CHM文档中定义了所需的SELECT语法。 它通常随MS Office 2000或更高版本一起安装，但是您必须在“ Program Files”特殊文件夹中进行查找才能找到它。 那里有很多有用的东西，我通常会自己创建一个快捷方式。

但是，由于没有Jet XML可安装的ISAM （IISAM），因此您必须做MS Access自己做的事情来导入XML格式数据。

尽管这确实涉及循环，但是您可以以比一般人更好的最佳方式来进行批量插入。 下面使用的代码试图做到这一点。

该程序具有一个带有单个菜单项mnuImportXML的窗体，以及一个名为FlexGrid的MSHFlexGrid，用于显示其在首次运行时创建的数据库中“记录”表的内容：

Option Explicit

Private Const CONNWG As String = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                               & "Jet OLEDB:Engine Type=5;" _
                               & "Jet OLEDB:Create System Database=True;" _
                               & "Data Source='$DB$.mdw';"
Private Const CONNDB As String = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                               & "Jet OLEDB:Engine Type=5;" _
                               & "Jet OLEDB:System Database='$DB$.mdw';" _
                               & "Data Source='$DB$.mdb';"

Private CN As ADODB.Connection
Private QueryRS As ADODB.Recordset
Private UpdateRS As ADODB.Recordset
Private XmlRS As ADODB.Recordset
Private recordsRS As ADODB.Recordset
Private AppendFields As Variant

Public Function OpenConnection(ByVal DbPath As String) As ADODB.Connection
    Dim ExtensionPos As Long

    ExtensionPos = InStrRev(DbPath, ".")
    If ExtensionPos > 0 Then DbPath = Left$(DbPath, ExtensionPos - 1)
    On Error Resume Next
    GetAttr DbPath & ".mdb"
    If Err Then
        On Error GoTo 0
        Set OpenConnection = CreateDB(DbPath)
    Else
        On Error GoTo 0
        Set OpenConnection = New ADODB.Connection
        OpenConnection.Open Replace$(CONNDB, "$DB$", DbPath)
    End If
End Function

Private Function CreateDB(ByVal DbPath As String) As ADODB.Connection
    Dim catDB As Object 'Don't early-bind ADOX objects.

    Set catDB = CreateObject("ADOX.Catalog")
    With catDB
        .Create Replace$(CONNWG, "$DB$", DbPath)
        .Create Replace$(CONNDB, "$DB$", DbPath)
        Set CreateDB = .ActiveConnection
        Set catDB = Nothing
    End With
    With CreateDB
        .Execute "CREATE TABLE [Records](" _
               & "[ID] IDENTITY CONSTRAINT PK_UID PRIMARY KEY," _
               & "[flda] TEXT(255) WITH COMPRESSION," _
               & "[fldb] TEXT(255) WITH COMPRESSION)", , _
                 adCmdText Or adExecuteNoRecords
    End With
End Function

Private Sub RefreshGrid()
    QueryRS.Open "[Records]", , , adLockReadOnly, adCmdTable
    Set FlexGrid.DataSource = QueryRS
    QueryRS.Close
End Sub

Private Sub Form_Load()
    Set CN = OpenConnection("demo.mdb")
    Set QueryRS = New ADODB.Recordset
    QueryRS.CursorLocation = adUseClient
    Set QueryRS.ActiveConnection = CN
    Set XmlRS = New ADODB.Recordset
    XmlRS.ActiveConnection = "Provider=MSDAOSP;Data Source=MSXML2.DSOControl.3.0"
    Set UpdateRS = New ADODB.Recordset
    Set UpdateRS.ActiveConnection = CN
    UpdateRS.Properties("Append-Only Rowset").Value = True
    AppendFields = Array("flda", "fldb")
    RefreshGrid
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then
        FlexGrid.Move 0, 0, ScaleWidth, ScaleHeight
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CN.Close
End Sub

Private Sub mnuImportXML_Click()
    XmlRS.Open "response.xml"
    Set recordsRS = XmlRS.Fields("record").Value
    UpdateRS.Open "Records", , , adLockOptimistic, adCmdTableDirect
    CN.BeginTrans
    With recordsRS
        Do Until .EOF
            UpdateRS.AddNew AppendFields, _
                            Array(.Fields(AppendFields(0)).Value, _
                                  .Fields(AppendFields(1)).Value)
            .MoveNext
        Loop
    End With
    CN.CommitTrans
    UpdateRS.Close
    Set recordsRS = Nothing
    XmlRS.Close
    RefreshGrid
End Sub

这里的关键是Menu事件处理程序mnuImportXML_Click （向下滚动到末尾），该事件处理程序将重复的第二级XML元素record的flda和fldb子元素的Text附加到Jet数据库表Records 。

注意以下用途：

UpdateRS.Properties("Append-Only Rowset").Value = True

这是在Form_Load中初始化期间完成的。 它可以提高性能。

我不知道有什么更快的方法可以完成此操作。 Jet不能将XML文档用作外部数据库。 它只能使用具有IISAM的数据库类型，例如Text，HTML，Excel 8.0，dBase IV和Paradox。

微软是否只是懒惰而没有考虑过将XML从Jet 4.0中剔除，XML文档的层级性质在不扩展Jet SQL语法的情况下并没有为他们提供很多选择，或者我还没有找到某些语法...我可以不说