Public Sub CopyQuery(sQueryName As String, sSourceDB As String, sDestinationDB As String, Optional bOverwrite As Boolean = False)

This example shows how to use the CopyQuery subroutine. The first example will copy the query called rpt11 from the src.mdb to the dest.mdb. The second will copy rpt12 from src.mdb to dest.mdb. If the query rpt12 exists in dest.mdb it will automatically be overwritten.

    CopyQuery "rpt11", "e:\temp\src.mdb", "e:\temp\dest.mdb"
    CopyQuery "rpt12", "e:\temp\src.mdb", "e:\temp\dest.mdb", True

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