Question

我一直在寻找一个解决方案来导出带有开放参数的查询。我需要将查询导出为格式化的Excel电子表格，并且无法为正在使用的数据库创建其他表，查询，表单或报表。我使用DoCmd.OutputTo，因为它导出格式化的查询不像DoCmd.TransferSpreadsheet但是我似乎无法使用定义的参数导出查询。我需要包含参数，否则用户将被迫输入开始和结束日期三次作为数据库因为某种原因要求startDate和endDate两次，以便保留excel电子表格和后续的outlook部分一致的我将不得不要求用户再次输入他们以前的参数

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

为了清楚起见，当前给出的SQL看起来类似于下面的省略字段

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")));

Answer 1

我建议你改变查询的sql。

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

''You could use a query specifically for this
Set qdfQry = CurrentDb.QueryDefs(tname)

sSQL=qdfQry.SQL

NewSQL = "SELECT [SWPS].STATION, [SWPS].START_DATE, [SWPS].END_DATE, " _
       & "FROM [SWPS] WHERE [SWPS].STATION Like '*' " _
       & "AND [SWPS].SWP_STATUS In ('A','P','W','T','R') " _
       & "AND [SWPS].START_DATE)<=#" & Format(DateStart, "yyyy/mm/dd") & "# " _
       & "AND [SWPS].END_DATE)>=#" & Format(DateEnd, "yyyy/mm/dd") & "#"

qdfQry.SQL = NewSQL

''Do the excel stuff

''Reset the query
qdfQry.SQL = sSQL

使用QueryDef的VBA DoCmd.OutputTo

1 个答案: