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

时间:2017-01-20 21:17:35

标签: xml ms-access vb6

我有一个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上找到的)?

1 个答案:

答案 0 :(得分:1)

我想要的SELECT语法仅在JETSQL40.CHM文档中定义。这通常与MS Office 2000或更高版本一起安装,但您必须在&#34; Program Files&#34;找到它的特殊文件夹。那里有足够的有用的东西,我通常自己创建一个快捷方式。

但是,由于没有Jet XML Installable ISAM (IISAM),您必须执行MS Access自行导入XML格式数据的事情。

虽然这确实涉及循环,但您可以以比人们通常做的更优化的方式进行批量插入。下面使用的代码试图这样做。

此程序有一个表单,其中包含一个菜单项mnuImportXML和一个名为FlexGrid的MSHFlexGrid,用于显示&#34;记录&#34;的内容。第一次运行时创建的数据库中的表:

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的fldafldb子元素的Text元素record进入Jet数据库表Records

请注意使用:

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

这是在Form_Load中初始化期间完成的。它稍微提高了性能。

我不知道有任何更快的方法来实现这一目标。 Jet不能将XML文档用作外部数据库。它只能使用具有IISAM的数据库类型,例如Text,HTML,Excel 8.0,dBase IV和Paradox。

Microsoft是否只是懒惰并且不假思索地将XML从Jet 4.0中删除,XML文档的分层特性在没有扩展Jet SQL语法的情况下也没有留下很多选项,或者有一些语法我还没有发现......我不能说。