Access视频课程
网站公告
·Access快速平台QQ群号:84825014    ·Access快速开发平台下载地址及教程    ·欢迎添加微信交流账号:AccessoftChu    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

【Access源码示例】导入系列-Excel之循环读取单元格数据方法

时 间:2020-08-25 09:25:21
作 者:金宇   ID:43  城市:江阴
摘 要:通过循环读取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
    Dim objExcel   As Object
    Dim objBook    As Object
    Dim objSheet   As Object
    Dim lngI       As Long
    
    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 objExcel = CreateObject("Excel.Application")
    Set objBook = objExcel.Workbooks.Open(Me.strFilePath)
    Set objSheet = objBook.WorkSheets("" & Me.strSheetName & "")
    objSheet.Select
    With objSheet
        For lngI = 2 To 65536  '循环行记录
            If .Cells(lngI, 1) = "" Then Exit For
            rst.AddNew
            rst![Part No] = .Cells(lngI, 1)
            rst![Part Name] = .Cells(lngI, 2)
            rst![Category] = .Cells(lngI, 3)
            rst![Part Type] = .Cells(lngI, 4)
            rst![Unit Cost] = .Cells(lngI, 5)
            rst![Cons Cost] = .Cells(lngI, 6)
            rst.Update
        Next
    End With

    rst.Close

    MsgBox "Import Success!"
    DoCmd.OpenTable "tb_Parts"
    
Exithere:
    DoCmd.Hourglass False
    If Not objBook Is Nothing Then objBook.Saved = True
    If Not objExcel Is Nothing Then objExcel.Quit
    Set objSheet = Nothing
    Set objBook = Nothing
    Set objExcel = Nothing
    Set rst = Nothing
    Exit Sub

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

图   示:



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

最新评论 查看更多评论(0)

发表评论您的评论将提升作者分享的动力!快来评论一下吧!

用户名:
密 码:
内 容:
 

常见问答

技术分类

相关资源

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