listbox code tidying up

jasn_78

Registered User.
Local time
Today, 16:42
Joined
Aug 1, 2001
Messages
214
hey i have the below code to store options on a list box as a query if some1 can make any recommendations they would change to this would be nice. also how would i make this into a function so i could use the same code on various listboxes for different queries or am i better just changing it for each listbox?

Code:
Private Sub cmdOK_Click()

 ' Declare variables
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim varItem As Variant
    Dim strCriteria As String
    Dim strSQL As String
    Dim querycount As Integer
    
' Get the database and stored query
    Set db = CurrentDb()

'test to see if qryDEPT currentlty exists
    For Each qdf In db.QueryDefs
    If qdf.Name = "qryDEPT" Then
    querycount = 1
    End If
    Next

'delete qryDEPT if it exists
    If querycount = 1 Then
    db.QueryDefs.Delete "qryDEPT"
    Set qdf = db.CreateQueryDef("qryDEPT")
    Else
    Set qdf = db.CreateQueryDef("qryDEPT")
    End If
    
' Loop through the selected items in the list box and build a text string
    If Me!lstDEPT.ItemsSelected.Count > 0 Then
        For Each varItem In Me!lstDEPT.ItemsSelected
            strCriteria = strCriteria & "IDEPTBL.IDEP_NUMBER = " _
                        & CStr(Me!lstDEPT.ItemData(varItem)) & " OR "
        Next varItem
        strCriteria = Left(strCriteria, Len(strCriteria) - 3)
    Else
        strCriteria = ""
    End If
' If options selected Build the new SQL statement incorporating the string
    If strCriteria <> "" Then
        strSQL = "SELECT IDEPTBL.IDEP_NUMBER, IDEPTBL.IDEP_DESC FROM IDEPTBL " & _
                 "WHERE " & strCriteria
'if nothing selected exit db
    Else
        Set db = Nothing
        Set qdf = Nothing
        DoCmd.Close
        Exit Sub
    End If
    
' Apply the new SQL statement to the query
    qdf.sql = strSQL
' Open the query
    DoCmd.OpenQuery "qryDEPT"
' Empty the memory
    Set db = Nothing
    Set qdf = Nothing
'Exit Form

DoCmd.Close
DoCmd.Close

End Sub

Thanks
Jason
 

Users who are viewing this thread

Back
Top Bottom