华夏银行王耀庭:将Access数据库记录导入Excel工作表中

来源:百度文库 编辑:中财网 时间:2024/04/28 08:40:02
 

    示例:假设Excel工作簿和Access数据库在同一文件夹中,Access数据库名称是“职工管理.mdb”,需要把其中“职工基本信息”表中的所有记录导入Excel工作表中,代码如下:

Sub Test()
    Dim myData As String, myTable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    myData = ThisWorkbook.Path & "\职工管理.mdb"
    myTable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open myData
    End With
    SQL = "select * from " & myTable & " order by 职工编号"
    
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '或   rs.Open myTable, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    '或用 Set rs = cnn.Execute(SQL) 代替以上2行代码
    
    If rs.EOF And rs.BOF Then   '或 If rs.RecordCount = 0
        MsgBox "数据表中没有记录!", vbCritical
    Else
        MsgBox "数据库中的记录数为:" & rs.RecordCount
        For i = 1 To rs.Fields.Count
            Cells(1, i) = rs.Fields(i - 1).Name
        Next i
        With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
        Range("A2").CopyFromRecordset rs
        ActiveSheet.Cells.Font.Size = 10
        ActiveSheet.Columns.AutoFit   '最适合的列宽
        'ActiveSheet.Rows.AutoFit     '最适合的行高
    End If
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub