I'm trying to write some vba to export filtered records from a subform. I've found a number of post related to this issue and I've cobbled the code below from those post.
When I run it I get a run-time error saying the Object '__temp' already exist. When I click debug it highlights the line Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL).
Thank you for you help.
When I run it I get a run-time error saying the Object '__temp' already exist. When I click debug it highlights the line Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL).
Thank you for you help.
Code:
Private Sub yourButtonToImportName()
Dim db As dao.Database
Dim qrydef As dao.QueryDef
Dim strSQL As String
Dim bolWithFilterOn As Boolean
Dim strTempQryDef As String
Dim strRecordSource As String
strTempQryDef = "__temp"
bolWithFilterOn = me.subsearch_frm.Form.FilterOn
strRecordSource = me.subsearch_frm.Form.RecordSource
If InStr(strRecordSource, "SELECT ") <> 0 Then
strSQL = strRecordSource
Else
strSQL = "SELECT * FROM [" & strRecordSource & "]"
End If
' just in case our sql string ends with ";"
strSQL = Replace(strSQL, ";", "")
If bolWithFilterOn Then
strSQL = strSQL & _
IIf(InStr(strSQL, "WHERE ") <> 0, " And ", " Where ") & _
me.subsearch_frm.Form.Filter
End If
Set db = CurrentDb
'create temporary query
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
db.QueryDefs.Append qrydef
Set qrydef = Nothing
DoCmd.TransferSpreadsheet TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=strTempQryDef, _
FileName:=Replace(CurrentProject.Path & "\", "\\", "\") & strTempQryDef & ".xlsx"
' Delete the temporary query
db.QueryDefs.Delete strTempQryDef
Set db = Nothing
End Sub