使用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語法的情況下並沒有為他們提供很多選擇，或者我還沒有找到某些語法...我可以不說