读取ACCESS数据库表数据

Sub 读取数据库表数据()
    Dim cnn As New Connection, rs As New Recordset
    Dim strSql As String, i As Long, Sh As Worksheet
    Dim t1, t2 As Date
    On Error Resume Next
    t1 = Time
'    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
'            & "Data Source=" & ThisWorkbook.Path & "\汉语料库.mdb"   '用于打开低版本mdb数据库
    
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='"
    strConn = strConn & ActiveWorkbook.Path & "\汉语料库.accdb'"
    
    cnn.Open strConn
    strSql = "Select * FROM 图书库" '从“客户”表中获取全部数据
    rs.Open strSql, cnn, adOpenStatic    '打开记录集
    
    Set Sh = Worksheets.Add '添加工作表
    Sh.Name = "图书库"    '设置工作表名称
    With Sh
        For i = 0 To rs.Fields.Count - 1    '用字段名作为表头
            .Cells(1, i + 1) = rs.Fields(i).Name
        Next
        .Range("A2").CopyFromRecordset rs   '复制记录集中的数据
        .Columns.AutoFit    '设置列宽为自动适应
    End With
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    t2 = Time - t1
    MsgBox Format(t2, "Scientific")   '115747 9s
End Sub

作者：LiW