将 Querydef 的结果导出到活动 Excel 工作表答案

【问题标题】：Exporting Results Of A Querydef To The Active Excel Worksheet将 Querydef 的结果导出到活动 Excel 工作表
【发布时间】：2013-08-23 05:15:24
【问题描述】：

帮助！我有一个用于打开 Excel 模板的数据库，将 QueryDef 的结果导出到活动工作表，然后使用新文件名保存该文件。听起来很容易。我遇到的问题是使用 DoCmd.TransferSpreadsheet 将结果导出到活动工作表中。它可以做我需要做的所有事情，除了实际传输数据......这意味着，它几乎没用。任何帮助将不胜感激。我正要拔头发。先感谢您。

创建 QDF

Set qdf = db.CreateQueryDef("" & strCrt, "SELECT [Zones Asset Information].*  FROM " & _
"[Zones Asset Information] WHERE [Zones Asset Informaiton].[Invoice Number] " = '" & strCrt    & "';")

打开模板

  Set xlWB = xlApp.Workbooks.Open(WB_PATH)
    Set xlWS = xlWB.Sheets(3)
    xlWS.Activate

尝试导出

 DoCmd.TransferSpreadsheet acExport, 10, "" & strCrt, , True, "orig data"    'Don't know how to   specify Active Worksheet instead of a filename?!?
    DoCmd.DeleteObject acQuery, "" & strCrt

保存文件

 sSaveAsFileName = FLDR_PATH & "Accounting_Breakdown_Zones_Invoice_xxxxxx.xlsx"
    Debug.Print "sSaveAsFileName: " & sSaveAsFileName
    xlWB.SaveAs sSaveAsFileName

【问题讨论】：

标签： ms-access automation vba

【解决方案1】：

将数据从 Access 导出到 Excel 有两种方法：

打开一个 MsExcel 对象并使用它的方法来操作 Excel
使用TransferSpreadsheet方法导出数据

你正在做两者的混合，这就是你没有得到结果的原因。

TransferSpreadsheet 会将给定查询导出到指定文件，但您不能指定工作表。

如果指定工作表很重要，您将不得不使用 Excel 对象来完成，并逐个单元格地发送信息，如果可以证明原因，则需要做更多的工作。

【讨论】：

【解决方案2】：

E Mett，感谢您的指导。不得不重新处理现在不 100% 同意帖子标题的过程，但我想我会分享以防其他人需要类似的东西。再次感谢！！

Private Sub ExportTable_MultipleWB()
Dim db As DAO.Database, rs As DAO.Recordset, rs2 As DAO.Recordset, strFilter As String, strFilter2 As String, _
    sSaveAsFileName As String

Dim xlApp As Excel.Application, xlWB As Excel.Workbook, xlWS As Excel.Worksheet
Dim bolIsExcelRunning As Boolean

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT DISTINCT [mytable].[PO Number], [mytable].[Invoice Number] " & _
                                  "FROM [mytable] ORDER BY [mytable].[PO Number], [mytable].[Invoice Number];", dbOpenSnapshot)

rs.MoveFirst

Do While Not rs.EOF

strFilter = rs.Fields(1).Value
strFilter2 = rs.Fields(0).Value

Set rs2 = db.OpenRecordset("SELECT [mytable].*  FROM [mytable] WHERE [mytable].[Invoice Number] = '" & strFilter & "';")

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")

If Err.Number <> 0 Then
    Set xlApp = CreateObject("Excel.Application")
Else
    bolIsExcelRunning = True
End If

xlApp.Visible = True

Set xlWB = xlApp.Workbooks.Open(WB_PATH)
Set xlWS = xlWB.Sheets(3)

xlWS.Activate

With xlWS

For iCols = 0 To rs2.Fields.Count - 1
    xlWS.Cells(1, iCols + 1).Value = rs2.Fields(iCols).Name
Next
    xlWS.Range(xlWS.Cells(1, 1), _
    xlWS.Cells(1, rs2.Fields.Count)).Font.Bold = True
    xlWS.Range("A2").CopyFromRecordset rs2
End With

sSaveAsFileName = FLDR_PATH & "myfilename_" & strFilter & "_PO-" & strFilter2 & ".xlsx"
    Debug.Print "sSaveAsFileName: " & sSaveAsFileName

xlWB.SaveAs sSaveAsFileName
Set xlWS = Nothing

xlWB.Close False
Set xlWB = Nothing

rs.MoveNext

Loop

rs.Close
rs2.Close

If Not bolIsExcelRunning Then
xlApp.Quit
End If

Set xlApp = Nothing

Set rs = Nothing
Set rs2 = Nothing

Set db = Nothing

结束子

【讨论】：