R
ryan.fitzpatrick3
How do I fix this error? It used to work but it doesn't now. It refers
to this code below. I added this to it.
' Get the SQL for the existing query
If Me.RecordSource = "4QryAdageVolumeSpendYearsum" Then
strSQL = dbCurr.QueryDefs("4QryAdageVolumeSpendYearsum").SQL
If Me.RecordSource = "3QryAdageVolumeSpendsum" Then
strSQL = dbCurr.QueryDefs("3QryAdageVolumeSpendsum").SQL
End If
End If
If you ask why I added it because on the form I have it defaulted to a
record source that pulls a query, but a user can select to sum up the
query results into a summed version of the same info; this is another
query, so basically when a user run's the query it'll prompt them "do
you want to sum up the results" if yes then the form goes to the
query2 record source if no then it stays on the default record source.
The code up above 'should' make it where depending on what query
record source is selected it'll export that information to excel.
Private Sub Export_Click()
On Error GoTo Err_Export_Click
Dim dbCurr As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim lngOrderBy As Long
Dim strQueryName As String
Dim strSQL As String
If MsgBox( _
"Do you want to export to Excel?", _
vbQuestion + vbYesNo, _
"Export to Excel?") _
= vbNo _
Then
Exit Sub
End If
' You only need to go to this effort if there's a filter
If Len(Me.Filter) > 0 Then
Set dbCurr = CurrentDb
' Get the SQL for the existing query
If Me.RecordSource = "4QryAdageVolumeSpendYearsum" Then
strSQL = dbCurr.QueryDefs("4QryAdageVolumeSpendYearsum").SQL
If Me.RecordSource = "3QryAdageVolumeSpendsum" Then
strSQL = dbCurr.QueryDefs("3QryAdageVolumeSpendsum").SQL
End If
End If
' Check whether there's an ORDER BY clause in the SQL.
' If there is, we need to put the WHERE clause in front of it.
lngOrderBy = InStr(strSQL, "ORDER BY")
If lngOrderBy > 0 Then
strSQL = Left(strSQL, lngOrderBy - 1) & _
" WHERE " & Me.Filter & " " & _
Mid(strSQL, lngOrderBy)
Else
' There's no ORDER BY in the SQL.
' Remove the semi-colon from the end, then append the WHERE clause
strSQL = Left(strSQL, InStr(strSQL, ";") - 1) & _
" WHERE " & Me.Filter
End If
' By using the current date and time, hopefully that means
' a query by that name won't already exist
strQueryName = "qryTemp" & Format(Now, "yyyymmddhhnnss")
' Create the temporary query
Set qdfTemp = dbCurr.CreateQueryDef(strQueryName, strSQL)
' Export the temporary query
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel9, _
tableName:=strQueryName, FileName:= _
"C:\Documents and Settings\All Users\Desktop\Adage
Downloaded On" & Format(Now, "mm" & "-" & "dd" & "-" & "yyyy" & "@" &
"hh" & "nn") & ".xls", _
hasfieldnames:=True
' Delete the temporary query
dbCurr.QueryDefs.Delete strQueryName
Else
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel9, _
tableName:=strQueryName, FileName:= _
"C:\Documents and Settings\All Users\Desktop\Adage
Downloaded On" & Format(Now, "mm" & "-" & "dd" & "-" & "yyyy" & "@" &
"hh" & "nn") & ".xls", _
hasfieldnames:=True
End If
Exit_Export_Click:
Set dbCurr = Nothing
Exit Sub
Err_Export_Click:
MsgBox Err.Description
Resume Exit_Export_Click
End Sub
to this code below. I added this to it.
' Get the SQL for the existing query
If Me.RecordSource = "4QryAdageVolumeSpendYearsum" Then
strSQL = dbCurr.QueryDefs("4QryAdageVolumeSpendYearsum").SQL
If Me.RecordSource = "3QryAdageVolumeSpendsum" Then
strSQL = dbCurr.QueryDefs("3QryAdageVolumeSpendsum").SQL
End If
End If
If you ask why I added it because on the form I have it defaulted to a
record source that pulls a query, but a user can select to sum up the
query results into a summed version of the same info; this is another
query, so basically when a user run's the query it'll prompt them "do
you want to sum up the results" if yes then the form goes to the
query2 record source if no then it stays on the default record source.
The code up above 'should' make it where depending on what query
record source is selected it'll export that information to excel.
Private Sub Export_Click()
On Error GoTo Err_Export_Click
Dim dbCurr As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim lngOrderBy As Long
Dim strQueryName As String
Dim strSQL As String
If MsgBox( _
"Do you want to export to Excel?", _
vbQuestion + vbYesNo, _
"Export to Excel?") _
= vbNo _
Then
Exit Sub
End If
' You only need to go to this effort if there's a filter
If Len(Me.Filter) > 0 Then
Set dbCurr = CurrentDb
' Get the SQL for the existing query
If Me.RecordSource = "4QryAdageVolumeSpendYearsum" Then
strSQL = dbCurr.QueryDefs("4QryAdageVolumeSpendYearsum").SQL
If Me.RecordSource = "3QryAdageVolumeSpendsum" Then
strSQL = dbCurr.QueryDefs("3QryAdageVolumeSpendsum").SQL
End If
End If
' Check whether there's an ORDER BY clause in the SQL.
' If there is, we need to put the WHERE clause in front of it.
lngOrderBy = InStr(strSQL, "ORDER BY")
If lngOrderBy > 0 Then
strSQL = Left(strSQL, lngOrderBy - 1) & _
" WHERE " & Me.Filter & " " & _
Mid(strSQL, lngOrderBy)
Else
' There's no ORDER BY in the SQL.
' Remove the semi-colon from the end, then append the WHERE clause
strSQL = Left(strSQL, InStr(strSQL, ";") - 1) & _
" WHERE " & Me.Filter
End If
' By using the current date and time, hopefully that means
' a query by that name won't already exist
strQueryName = "qryTemp" & Format(Now, "yyyymmddhhnnss")
' Create the temporary query
Set qdfTemp = dbCurr.CreateQueryDef(strQueryName, strSQL)
' Export the temporary query
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel9, _
tableName:=strQueryName, FileName:= _
"C:\Documents and Settings\All Users\Desktop\Adage
Downloaded On" & Format(Now, "mm" & "-" & "dd" & "-" & "yyyy" & "@" &
"hh" & "nn") & ".xls", _
hasfieldnames:=True
' Delete the temporary query
dbCurr.QueryDefs.Delete strQueryName
Else
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel9, _
tableName:=strQueryName, FileName:= _
"C:\Documents and Settings\All Users\Desktop\Adage
Downloaded On" & Format(Now, "mm" & "-" & "dd" & "-" & "yyyy" & "@" &
"hh" & "nn") & ".xls", _
hasfieldnames:=True
End If
Exit_Export_Click:
Set dbCurr = Nothing
Exit Sub
Err_Export_Click:
MsgBox Err.Description
Resume Exit_Export_Click
End Sub