1

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

ヘルプ/提案？ありがとうございました。

Windows7で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

Remouに感謝します！

4

1 に答える 1

1

クエリのSQLを適切な文字列に設定してから、クエリをエクスポートすることをお勧めします。

sSQL="SELECT * FROM Table WHERE Field=" & me.MyText
If IsNull(DLookup("name", "msysobjects", "name='query1'")) Then
    CurrentDb.CreateQueryDef "Query1", sSQL
Else
    CurrentDB.QueryDefs("Query1").SQL = sSQL
End If     

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Query1", sFullPath

開いているフォームを参照するクエリを作成できます。

SELECT Test.ID, Test.Data
FROM Test
WHERE Test.AField=[forms]![test]![pickone]
于 2012-09-26T19:06:20.193 に答える