导出access查询或者Access表到指定excel表

导入导出是程序中非常重要的组成部分。Access中，系统有自带的导入导出功能。但是功能过于死板。

下面的示例我们用代码设计一个Access查询或者表导出到指定的Excel工作表

如下图。导出按钮

详细源码：

'---------------------------------------------------------------------------------------

' Procedure : QueryToExcel

' DateTime  : 2008-12-2 00:02

' Author      : Henry D. Sy

' Purpose    : strQueryName 查询名（表名）

'                   xlsName 工作簿名

'                   strShtName 工作表名

'                   需要引用Microsoft Excel 11.0 Object Library

'---------------------------------------------------------------------------------------

'

Sub QueryToExcel(ByVal strQueryName As String, ByVal xlsName As String, ByVal _

                                                                        strShtName As String)

' Send the Query results to Excel

' for further analysis

    Dim rs As ADODB.Recordset

    Dim objXL As Excel.Application

    Dim objWs As Excel.Workbook

    Dim fld As ADODB.Field

    Dim intCol As Integer

    Dim intRow As Integer

    Set rs = New ADODB.Recordset

    ' Get the desired data into a recordset

    rs.Open strQueryName, CurrentProject.Connection

    ' Launch Excel

    Set objXL = New Excel.Application

    ' Open a  worksheet

    Set objWs = objXL.Workbooks.Open(CurrentProject.Path & "" & xlsName & _

                                     ".xls")

    objWs.Worksheets(strShtName).Activate

    ' Copy the data

    ' First the field names

    For intCol = 0 To rs.Fields.Count - 1

        Set fld = rs.Fields(intCol)

        objWs.Worksheets(strShtName).Cells(1, intCol + 1) = fld.Name

    Next intCol

    ' Now the actual data

    intRow = 2

    Do Until rs.EOF

        For intCol = 0 To rs.Fields.Count - 1

            objWs.Worksheets(strShtName).Cells(intRow, intCol + 1) = _

            rs.Fields(intCol).Value

        Next intCol

        rs.MoveNext

        intRow = intRow + 1

    Loop

    ' Make the worksheet visible

    objXL.Visible = True

    rs.Close

    Set rs = Nothing

End Sub

窗体调用代码：

Private Sub Command0_Click()

    QueryToExcel "要导出的查询（表）名", "工作簿名", "工作表名"

End Sub