关于导出问题，请教！

snryga

'---------------------------------------------------------------------------------------
' 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 & _
                                     ".xlsx")   
    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 导出_CRM_Click()
QueryToExcel "统计表", "CRM", "统计"
QueryToExcel "实施清单", "CRM", "清单"
End Sub

如何实现导出不生成2个EXCEL表，在一个EXCEL表中不同Sheet显示。

snryga

没人支持下

sxgaobo

DoCmd.TransferSpreadsheet acExport, 8, "A表","文件名", True, ""
DoCmd.TransferSpreadsheet acExport, 8, "B表","文件名", True, ""
DoCmd.TransferSpreadsheet acExport, 8, "C表","文件名", True, ""