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

Question

我在“/response/result/record”下有一个包含许多记录的 XML 文件。例如：

<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 上找到）显示的这种时髦的“选择...”语法的文档？

Answer 1

据我所知，您想要的 SELECT 语法仅在 JETSQL40.CHM 文档中定义。这通常与 MS Office 2000 或更高版本一起安装，但您必须在“程序文件”特殊文件夹中挖掘才能找到它。那里有足够有用的东西，我通常会自己创建一个快捷方式。

但是，由于没有 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

这里的关键是菜单事件处理程序mnuImportXML_Click（向下滚动到末尾），它将重复的二级XML元素record的flda和fldb子元素的文本附加到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 语法，或者有一些我还没有找到的语法......我不能说。