问使用QueryDef的VBA DoCmd.OutputTo

EN

Sub Main()
On Error GoTo Main_Err


'Visually Display Process
DoCmd.Hourglass True

Dim fpath As String
Dim tname As String
Dim cname As String
Dim tType As AcOutputObjectType
Dim tempB As Boolean

fpath = CurrentProject.path & "\"
'tType = acOutputTable
'tname = "APPROVED SWPS FOR LOOK AHEAD & BAR CHART"
tType = acOutputQuery
tname = "ASFLA&BC Query"
cname = "Temp BPC Calendar"


Dim qdfQry As DAO.QueryDef
Dim strStart As String
Dim strEnd As String

Set qdfQry = CurrentDb().QueryDefs(tname)


'strStart = InputBox("Please enter Start date (mm/dd/yyyy)")
'strEnd = InputBox("Please enter Start date (mm/dd/yyyy)")


qdfQry.Parameters("ENTER START DATE") = FormatDateTime("6/30/12", vbShortDate)   'strEnd
qdfQry.Parameters("ENTER END DATE") = FormatDateTime("7/1/12", vbShortDate) 'strStart





tempB = Backup(fpath, qdfQry, tType)
If (Not tempB) Then
    MsgBox "Excel Conversion Ended Prematurely..."
    Exit Sub
End If

'    tempB = sendToOutlook(qdfQry, cname)
'    If (Not tempB) Then
'        MsgBox "Access Conversion Ended Prematurely..."
 '        Exit Sub
'    End If

MsgBox "Procedure Completed Successfully"

Main_Exit:
    DoCmd.Hourglass False
    Exit Sub

 Main_Err:
    DoCmd.Beep
    MsgBox Error$
    Resume Main_Exit
End Sub


'************************************************************************************
'*
'*                                      Excel PORTION
'*
'************************************************************************************



Public Function Backup(path As String, db As DAO.QueryDef, Optional outputType As     AcOutputObjectType) As Boolean
On Error GoTo Error_Handler
    Backup = False
    Dim outputFileName As String
Dim name As String
Dim tempB As Boolean

'Set Up All Name Variablesand
name = Format(Date, "MM-dd-yy") & ".xls"

'Cleans Directory of Any older files and places them in an archive
SearchDirectory path, "??-??-??.xls", name

'See If File Can Now Be Exported. If Already Exists ask to overwrite
outputFileName = path & name

tempB = OverWriteRequest(outputFileName)



If tempB Then
    'Formats The Table And Exports Into A Formatted SpreadSheet
    'Checks if an output type was added to the parameter if not defualt to table
    If Not IsMissing(outputType) Then
        DoCmd.OutputTo outputType, db.name, acFormatXLS, outputFileName, False
    Else
        DoCmd.OutputTo acOutputTable, db.name, acFormatXLS, outputFileName, False
    End If
Else
    Exit Function
End If



Backup = True

Error_Handler_Exit:
    Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.number & vbCrLf & "Error Source: Main Excel Backup" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"

Resume Error_Handler_Exit
End Function

PARAMETERS [ENTER START DATE] DateTime, [ENTER END DATE] DateTime;
SELECT [SWPS].STATION,
       [SWPS].START_DATE, 
       [SWPS].END_DATE, 
FROM [SWPS]
WHERE ((([SWPS].STATION) 
Like ("*")) 
AND (([SWPS].START_DATE)<=[ENTER END DATE]) 
AND (([SWPS].END_DATE)>=[ENTER START DATE]) 
AND (([SWPS].SWP_STATUS) In ("A","P","W","T","R")));