【Access源码示例】导入系列-Excel之ADO记录集方法

时　间:2020-08-11 08:36:37
作　者:金宇   ID：43  城市：江阴
摘　要:使用ADO的记录集方法循环将Excel数据导入至Access。
正　文:

使用ADO的记录集方法循环将Excel数据导入至Access，具体代码如下：

Private Sub btnImport_Click()
On Error GoTo ErrorHandler:
    Dim strSQL   As String
    Dim rst      As Object
    Dim cnn      As Object
    Dim rstXL    As Object
    
    
    If IsNull(Me.strFilePath) Then
        MsgBox "请先选择文件!", vbInformation, "提示"
        Me.strFilePath.SetFocus
        Exit Sub
    End If
    If IsNull(Me.strSheetName) Then
        MsgBox "请先选择Excel工作表!", vbInformation, "提示"
        Me.strSheetName.SetFocus
        Exit Sub
    End If
    

    '打开Access记录集
    Set rst = CreateObject("adodb.recordset")
    rst.Open "select * from tb_Parts where 1=2", CurrentProject.Connection, 1, 3
    
    '打开Excel记录集
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Me.strFilePath & ";Extended Properties='Excel 12.0;HDR=Yes';"
    Set rstXL = cnn.Execute("select * from [" & Me.strSheetName & "$]")
    Do While Not rstXL.EOF
        rst.AddNew
        rst![Part No] = rstXL![Part No]
        rst![Part Name] = rstXL![Part Name]
        rst![Category] = rstXL![Category]
        rst![Part Type] = rstXL![Part Type]
        rst![Unit Cost] = rstXL![Unit Cost]
        rst![Cons Cost] = rstXL![Cons Cost]
        rst.Update
        rstXL.MoveNext
    Loop
     
    rst.Close
    Set rst = Nothing
    rstXL.Close
    Set rstXL = Nothing
    MsgBox "Import Success!"
    DoCmd.OpenTable "tb_Parts"
    
Exithere:
    DoCmd.Hourglass False
    Exit Sub

ErrorHandler:
        MsgBox Err.Description, vbInformation, "提示"
        Resume Exithere
End Sub

附   件:

点击下载此附件

图   示: