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