学步园

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