Results 1 to 3 of 3
  1. #1
    Join Date
    Dec 2003
    Posts
    138

    Question Unanswered: Help! Visual Basic

    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

  2. #2
    Join Date
    Dec 2003
    Posts
    138
    It is the report Options table (the ok command button) I'm having trouble getting to work.

    Dendalee
    Attached Files Attached Files

  3. #3
    Join Date
    Dec 2003
    Posts
    138
    I got it to work - thanks anyway!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •