Just paste this source code into a module called basQueries and include it in your project.
'----------------------------------------------------------------------
'
' Class Name: basQueries
' Written By: C&D Programming Corp.
' Create Date: 5/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'
' Deletes a query from the specified database
'
Public Sub DeleteQuery(sQueryName As String, db As Database)
On Error GoTo Handler
db.QueryDefs.Delete sQueryName ' remove query
Exit Sub
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
'
' Returns the QueryDef object of the specified query in the specified database
' If it is not found in the database the routine returns Nothing
'
Public Function FindQuery(sQueryName As String, db As Database) As QueryDef
Dim qry As QueryDef
On Error GoTo Handler
' We could also access the named query by setting an error handler
' and calling the item property with the query name. We opted for
' this "cleaner" method.
For Each qry In db.QueryDefs ' search querydef collection
If qry.Name = sQueryName Then
Set FindQuery = qry ' return querydef
Exit Function
End If
Next
Set FindQuery = Nothing ' clean up
Exit Function
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
'
' Copies a query from one database to another with an optional
' automatic overwrite.
'
Public Sub CopyQuery(sQueryName As String, sSourceDB As String, sDestinationDB As String, Optional bOverwrite As Boolean = False)
Dim qry As QueryDef
Dim qryNew As QueryDef
Dim sMsg As String
Dim dbSource As Database
Dim dbDest As Database
Set dbSource = DBEngine.OpenDatabase(sSourceDB) ' open database
Set qry = FindQuery(sQueryName, dbSource) ' get the source query object
If qry Is Nothing Then
' could not find query in source table so let's just get out of here.
' should probably raise an error or something. We'll leave this up
' to your particular implementation of this routine.
dbSource.Close
Exit Sub
End If
Set dbDest = DBEngine.OpenDatabase(sDestinationDB) ' open database
Set qryNew = FindQuery(sQueryName, dbDest) ' see if the dest query exists
If Not qryNew Is Nothing Then ' This means we found the query.
If bOverwrite Then ' if we should auto overwrite, just delete the query
DeleteQuery sQueryName, dbDest
Else ' otherwise notify the user and let them decide
If qry.SQL = qryNew.SQL Then
sMsg = "The contents of the queries are identical."
Else
sMsg = "The contents of the queries are different."
End If
If MsgBox("The query " & sQueryName & _
" already exists in the destination database." & _
vbCr & vbCr & _
"The source query was last updated on " & _
qry.LastUpdated & vbCr & _
"The destination query was last updated on " & _
qryNew.LastUpdated & vbCr & _
sMsg & vbCr & vbCr & _
"Do you want to replace the query in the destination database?", _
vbYesNo Or vbExclamation) = vbYes Then
DeleteQuery sQueryName, dbDest
Else
Set qry = Nothing
Set qryNew = Nothing
dbDest.Close
Exit Sub ' we don't want to overwrite the query.
End If
End If
End If
Set qryNew = dbDest.CreateQueryDef(qry.Name, qry.SQL) ' copy query
Set qry = Nothing
Set qryNew = Nothing
dbDest.Close ' close db
dbSource.Close
Exit Sub
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub