I'm a very newborn newbie when it comes to VBA. I have a database, which I want to pull information from a table for reports. I want the user to be able to create his or her own query (without permanently creating a query). I found a tutorial on how to do this, but the code is written for 2003 version, not 2007 version. I'm not sure how to change it. The code is below: Of course, ADO and ADOX is obsolete. Access now uses DAO according to the sites that I've searched. All help is very much appreciated!


' This code uses ADO and ADOX and is suitable for Access 2000 (and later).
' A reference must be set to Microsoft ADO Ext. 2.7 for DDL and Security.

Private Sub cmdOK_Click()
On Error GoTo cmdOK_Click_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOx.View
Dim varItem As Variant
Dim strType As String
Dim strYears As String
Dim strArea As String
Dim strLevel As String
Dim str As String
Dim strTypeCondition As String
Dim strYearsCondition As String
Dim strAreaCondition As String
Dim strLevelCondition As String
Dim strSQL As String
' Check for the existence of the stored query
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "qryModelQuery" Then
blnQueryExists = True
Exit For
End If
Next qry
' Create the query if it does not already exist
If blnQueryExists = False Then
cmd.CommandText = "SELECT * FROM tblStaff"
cat.Views.Append "qryModelQuery", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "qryModelQuery") = acObjStateOpen Then
DoCmd.Close acQuery, "qryModelQuery"
End If
' Build criteria string for Type
For Each varItem In Me.lsttype.ItemsSelected
strType = strType & ",'" & Me.lsttype.ItemData(varItem) & "'"
Next varItem
If Len(strType) = 0 Then
strType = "Like '*'"
Else
strType = Right(strType, Len(strType) - 1)
strType = "IN(" & strType & ")"
End If
' Build criteria string for Years
For Each varItem In Me.lstyears.ItemsSelected
strYears = strYears & ",'" & Me.lstyears.ItemData(varItem) & "'"
Next varItem
If Len(strYears) = 0 Then
strYears = "Like '*'"
Else
strYears = Right(strYears, Len(strYears) - 1)
strYears = "IN(" & strYears & ")"
End If
' Build criteria string for Area
For Each varItem In Me.lstarea.ItemsSelected
strArea = strArea & ",'" & Me.lstarea.ItemData(varItem) & "'"
Next varItem
If Len(strArea) = 0 Then
strArea = "Like '*'"
Else
strArea = Right(strArea, Len(strArea) - 1)
strArea = "IN(" & strArea & ")"
End If
' Build criteria string for Level
For Each varItem In Me.lstlevel.ItemsSelected
strLevel = strLevel & ",'" & Me.lstlevel.ItemData(varItem) & "'"
Next varItem
If Len(strLevel) = 0 Then
strLevel = "Like '*'"
Else
strLevel = Right(strLevel, Len(strLevel) - 1)
strLevel = "IN(" & strLevel & ")"
End If
' Get Years condition
If Me.optAndYears.Value = True Then
strYearsCondition = " AND "
Else
strYearsCondition = " OR "
End If
'Get Area condition
If Me.optAndArea.Value = True Then
strAreaCondition = " AND "
Else
strAreaCondition = " OR "
End If
' Get Level condition
If Me.optAndLevel.Value = True Then
strLevelCondition = " AND "
Else
strLevelCondition = " OR "
End If
' Build SQL statement
strSQL = "SELECT tblmodel.* FROM tblmodel " & _
"WHERE tblmodel.[Type of Observation] " & strType & _
strYearsCondition & "tblmodel.[Years of Leadership Exp] " & strYears & _
strAreaCondition & "tblModel.[Area of Plant] " & strArea & _
strLevelCondition & "tblmodel.[Level] " & strLevel & ";"
' Apply the SQL statement to the stored query
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("qryModelquery").Command
cmd.CommandText = strSQL
Set cat.Views("qrymodelQuery").Command = cmd
Set cat = Nothing
' Open the Query
DoCmd.OpenQuery "qrymodelQuery"
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
' Restore screen updating
cmdOK_Click_Exit:
DoCmd.Echo True
Exit Sub
cmdOK_Click_Err:
MsgBox "An unexpected error hass occurred." _
& vbCrLf & "Procedure: cmdOK_Click" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description:" & Err.Description _
, vbCritical, "Error"
Resume cmdOK_Click_Exit
End Sub


The Report Options query is the one I'm having trouble with. Thanks!