Access 在VBA中实现数据导出到Excel

http://hi.baidu.com/ohmyidea/item/e2bf6819735b6a34b93180cc

1.添加引用Microsoft Excel 11.0 Object Library。（这里用的是Microsoft Excel 2003）

2.定义获取数据集通用函数。

Public Function GetRS(ByVal strQuery As String) As ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection

On Error GoTo GetRS_Error
Set conn = CurrentProject.Connection
rs.Open Trim$(strQuery), conn, adOpenKeyset, adLockOptimistic
Set GetRS = rs

GetRS_Exit:
Set rs = Nothing
Set conn = Nothing
Exit Function

GetRS_Error:
MsgBox Err.Description
Resume GetRS_Exit
End Function

3.导出Excel代码。

Private Sub btnOutToExcel_Click()
Dim row As Integer
Dim col As Integer
Dim rs As New ADODB.Recordset
Dim ExcelApp As Excel.Application
Dim ExcelWst As Worksheet

Set rs = GetRS("SELECT * FROM PInfo") '获取数据集
Set ExcelApp = New Excel.Application
Set ExcelWst = ExcelApp.Workbooks.Add.Worksheets(1)

'导出字段名称
For col = 0 To rs.Fields.Count - 1
ExcelWst.Cells(1, col + 1) = rs.Fields(col).Name
Next col

'导出数据
row = 2
Do While Not rs.EOF
For col = 0 To rs.Fields.Count - 1
ExcelWst.Cells(row, col + 1) = rs.Fields(col)
Next col
row = row + 1
rs.MoveNext
Loop

rs.Close

ExcelWst.Columns.AutoFit '设置列宽
ExcelApp.Visible = True
End Sub