我有一个要导出为 Excel 2000 格式 (acSpreadsheetTypeExcel9) 的记录集。我相信我需要先将其放入表中,然后执行 DoCmd.TransferSpreadsheet(保持简单并且有效)。用户在表单中只设置了几个参数,因此就是Me。你会看到语法。
到目前为止,这是工作代码:
Select Case Me.Controls("frame_ChooseReport").Value
Case 1
sExecuteQuery = "qry_PDSR w/ Destruct Dates"
bHasProgramCode = True
sFileName = "Project_Doc_Submittal_Request_better"
Case 2
sExecuteQuery = "qry_PDSR w/Destruct Dates BE"
bHasProgramCode = False 'This is the only query here that doesn't have a Program Code parameter
sFileName = "Project_Doc_Submittal_Request_better_BE"
Case 3
sExecuteQuery = "qry_Project Documentation Submittal Request w/ Destruct Dates"
bHasProgramCode = True
sFileName = "Project_Doc_Submittal_Request_ENH"
Case 4
sExecuteQuery = "qry_Project_Doc_Submittal_Request_w_Destruct_Dates_HES_Installer"
bHasProgramCode = True
sFileName = "Project_Doc_Submittal_Request_Installer"
Case Else
Stop 'Error! This should never be reached!
End Select
'Execute query & save output to Excel
Set qdf = CurrentDb.QueryDefs(sExecuteQuery) 'Open the query
'Assign values to the query using the parameters option
If bHasProgramCode = True Then
qdf.Parameters(0) = Me.lbl_ProgramCodes.Section
qdf.Parameters(1) = Me.txt_StartDate
qdf.Parameters(2) = Me.txt_EndDate
Else
qdf.Parameters(0) = Me.txt_StartDate
qdf.Parameters(1) = Me.txt_EndDate
End If
sFullPath = Me.lbl_SaveTo.Caption & "\" & sFileName
Set rst = qdf.OpenRecordset 'Convert the querydef to a recordset and run it
If rst.BOF = True And rst.EOF = True Then
MsgBox "No records were found.", vbExclamation, "Empty recordset"
Exit Sub
End If
'Dump recordset into a table, export it to Excel, then delete it.
'Here is where the recordset needs to become a table.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_PDSR w/ Destruct Dates", sFullPath, True 'Export table to an Excel format
'Clean up!
DoCmd.DeleteObject acTable, gTEMP_TBL 'Done with the temporary table so delete it
rst.Close
qdf.Close
Set rst = Nothing
Set qdf = Nothing
帮助/建议?谢谢你。
在 Windows 7 中访问 2010
- - - - - 跟进 - - - - -
这是我添加的查询,它将根据 Remou 的建议使用打开的表单的引用:
SELECT dbo_PROJECT.PROJECTID, dbo_PROJECT.TITLE, dbo_PROJECT.PROGRAMCODE, dbo_PROJECT.PROJECTTYPE, dbo_PROJECT.REFERENCE, dbo_PROJECT.STATUS, dbo_PROJECT.PMC, dbo_TRANSACTION_SUM.STATUS, dbo_TRANSACTION_SUM.IMPORTEDDT, dbo_TRANSACTION_SUM.CHECKDT, dbo_PROJECT.NOTES, dbo_TRANSACTION_SUM.TRANSACTIONID, dbo_TRANSACTION_SUM.GL_ACCT, dbo_PROJECT_SUM.PAID_INCENT_TOTAL, dbo_TRANSACTION_SUM.AMOUNT
FROM ((dbo_INCENTIVE RIGHT JOIN dbo_PROJECT ON dbo_INCENTIVE.PROJECTID = dbo_PROJECT.PROJECTID) LEFT JOIN dbo_TRANSACTION_SUM ON dbo_INCENTIVE.INCENTIVEID = dbo_TRANSACTION_SUM.INCENTIVEID) LEFT JOIN dbo_PROJECT_SUM ON dbo_PROJECT.PROJECTID = dbo_PROJECT_SUM.PROJECTID
WHERE (((dbo_PROJECT.PROGRAMCODE) In ([Forms]![Submittal_Request_Report]![txt_ListProgramCodeSelections])) AND ((dbo_TRANSACTION_SUM.CHECKDT) Between [Forms]![Submittal_Request_Report]![txt_StartDate] And [Forms]![Submittal_Request_Report]![txt_EndDate]));
这是列表框的 On_Exit 事件中的例程:
Private Sub list_ProgramCodes_Exit(Cancel As Integer)
'Get selection from Program Code listbox and store it in a hidden textbox for the query.
Dim x As Long, sValue As String, ctlSource As Control
sValue = ""
Set ctlSource = Me!list_ProgramCodes
For x = 0 To ctlSource.ListCount - 1
If ctlSource.Selected(x) Then
sValue = sValue & ctlSource.Column(0, x) & ","
End If
Next
Me.txt_ListProgramCodeSelections.Value = Left(sValue, Len(sValue) - 1) 'Drop the last comma
Set ctlSource = Nothing
End Sub
效果很好!SQL 行In ([Forms]![Submittal_Request_Report]![txt_ListProgramCodeSelections])拉取隐藏文本框中的项目列表(使用标签不起作用),该文本框由表单上列表框中的选择填充。
现在是导出查询的代码:
Private Sub btn_RunReport_Click()
Dim sExecuteQuery As String, sFullPath As String, sFileName As String
On Error GoTo Err_btn_RunReport_Click
If Left(Me.lbl_SaveTo.Caption, 4) = "save" Then
MsgBox "Please select a folder to save the results to.", vbInformation, "No folder selected"
Exit Sub
End If
Select Case Me.Controls("frame_ChooseReport").Value
Case 1
sExecuteQuery = "qry_PDSR_Destruct_Dates_form"
sFileName = "Project_Doc_Submittal_Request.xls"
Case 2
sExecuteQuery = "qry_Project_Doc_Submittal Request w/ Destruct Dates_form"
sFileName = "Project_Doc_Submittal_Request_ENH.xls"
Case 3
sExecuteQuery = "qry_PDSR_w_Destruct_Dates_HES_Installer_form"
sFileName = "Project_Doc_Submittal_Request_Installer.xls"
Case Else
Stop 'Error! This should never be reached!
End Select
sFullPath = Me.lbl_SaveTo.Caption & "\" & sFileName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, sExecuteQuery, sFullPath, True 'Export table to an Excel format
Exit_btn_RunReport_Click:
Exit Sub
Err_btn_RunReport_Click:
MsgBox Err.Description
Resume Exit_btn_RunReport_Click
End Sub
谢谢雷穆!