CopyQueryDef Method Example

This example uses the CopyQueryDef method to create a copy of a QueryDef from an existing Recordset and modifies the copy by adding a clause to the SQL property. When you create a permanent QueryDef, spaces, semicolons, or linefeeds may be added to the SQL property; these extra characters must be stripped before any new clauses can be attached to the SQL statement.

Function CopyQueryNew(rstTemp As Recordset, _
    strAdd As String) As QueryDef

    Dim strSQL As String
    Dim strRightSQL As String

    Set CopyQueryNew = rstTemp.CopyQueryDef
    With CopyQueryNew
        ' Strip extra characters.
        strSQL = .SQL
        strRightSQL = Right(strSQL, 1)
        Do While strRightSQL = " " Or strRightSQL = ";" Or _
                strRightSQL = Chr(10) Or strRightSQL = vbCr
            strSQL = Left(strSQL, Len(strSQL) - 1)
            strRightSQL = Right(strSQL, 1)
        Loop
        .SQL = strSQL & strAdd
    End With

End Function

This example shows a possible use of CopyQueryNew().

Sub CopyQueryDefX()

    Dim dbsNorthwind As Database
    Dim qdfEmployees As QueryDef
    Dim rstEmployees As Recordset
    Dim intCommand As Integer
    Dim strOrderBy As String
    Dim qdfCopy As QueryDef
    Dim rstCopy As Recordset

    Set dbsNorthwind = OpenDatabase("Northwind.mdb")
    Set qdfEmployees = dbsNorthwind.CreateQueryDef( _
        "NewQueryDef", "SELECT FirstName, LastName, " & _
        "BirthDate FROM Employees")
    Set rstEmployees = qdfEmployees.OpenRecordset( _
        dbOpenForwardOnly)

    Do While True
        intCommand = Val(InputBox( _
            "Choose field on which to order a new " & _
            "Recordset:" & vbCr & "1 - FirstName" & vbCr & _
            "2 - LastName" & vbCr & "3 - BirthDate" & vbCr & _
            "[Cancel - exit]"))
        Select Case intCommand
            Case 1
                strOrderBy = " ORDER BY FirstName"
            Case 2
                strOrderBy = " ORDER BY LastName"
            Case 3
                strOrderBy = " ORDER BY BirthDate"
            Case Else
                Exit Do
        End Select
        Set qdfCopy = CopyQueryNew(rstEmployees, strOrderBy)
        Set rstCopy = qdfCopy.OpenRecordset(dbOpenSnapshot, _
            dbForwardOnly)
        With rstCopy
            Do While Not .EOF
                Debug.Print !LastName & ", " & !FirstName & _
                    " - " & !BirthDate
                .MoveNext
            Loop
            .Close
        End With
        Exit Do
    Loop

    rstEmployees.Close
    ' Delete new QueryDef because this is a demonstration.
    dbsNorthwind.QueryDefs.Delete qdfEmployees.Name
    dbsNorthwind.Close

End Sub