Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

【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

附   件:

点击下载此附件


图   示:



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助