Public Sub 技巧12_008()
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
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
'复制字段名
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.Columns(rs.Fields.Count).NumberFormat = "yyyy-mm-dd"
ActiveSheet.Columns.AutoFit
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub