D
Darkside
Hello, I am new to this forum and would be very appreciative if someone could
assist me with this problem. I found a code on the net that works with text
for the filter process, however I am working with integer. I am not sure
how/where to change the code to reflect integer instead of variant. Is it as
simple as replace the word variant with integer? or is it more complex? Any
help big or small would be appreciated. Here is the code where I think I need
to change it to integer:
Option Compare Database
Option Explicit
Public clsVarRecCount As Variant
Public clsStrSQLAction As String
Public clsStrCTLSQL As String
Public clsStrGetQuery As String
Public clsIntSelect As Integer
Dim clsStrTblCreate As String
Public clsStrFieldName As String
Public Property Get clsFrmName() As String
clsFrmName = Screen.ActiveForm.Name
End Property
Public Function RecordSelections()
'Declare the variables
'Form, Controls, and SQL variables
Dim clsFrm As Form
Dim clsStrFrmName As String
Dim clsCTL As Control
Dim clsVarSelection As Variant
Dim clsStrCTLName As String
Dim clsStrCTLChoices As String
Dim clsStrCTLSelections As String
Dim clsStrField As String
'Recordset Variables
Dim clsRSTQuery As New ADODB.Recordset
Dim clsIntRecCount As Integer
Dim clsFieldName As String
Dim varFieldType As Variant
Dim clsvarFinalCount As Variant
clsStrCTLSQL = ""
clsIntSelect = 0
'Set the variables
Set clsFrm = Screen.ActiveForm
clsStrFrmName = Screen.ActiveForm.Name
'Variables to be modified to record source being used
clsStrGetQuery = "MyQuery" 'Change this to the record source that is being
queried on
'Open the record source
clsRSTQuery.Open clsStrGetQuery, CurrentProject.Connection
'Reiterate through the recordset. If field names match the control names on
the form
'then the data type is captured for that field in order to create the
correct syntax
'for the SQL string
For clsIntRecCount = 1 To clsRSTQuery.Fields.Count
clsFieldName = clsRSTQuery(clsIntRecCount - 1).Name
clsStrField = clsRSTQuery(clsIntRecCount - 1).Name & ", "
varFieldType = clsRSTQuery(clsIntRecCount - 1).Type
clsStrFieldName = clsStrFieldName & clsStrField
'Reiterate through the form's control's collection to build SQL strings
For Each clsCTL In clsFrm.Controls
Select Case clsCTL.ControlType
Case acListBox
clsStrCTLName = clsCTL.Name
If clsStrCTLName = clsFieldName Then
Select Case varFieldType 'Determine which syntax to use
Case 2 To 6, 17, 72, 131 'Numeric
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices =
clsCTL.ItemData(clsVarSelection) & ", "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
Case 7 'Date
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices = "#" &
clsCTL.ItemData(clsVarSelection) & "# , "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
Case 202 'Text
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices = "'" &
clsCTL.ItemData(clsVarSelection) & "' , "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
End Select 'varFieldType
End If 'End control name evaluation
If Len(clsStrCTLSQL) > 0 Then
If Len(clsStrCTLSelections) > 0 Then
clsStrCTLSelections = Left(clsStrCTLSelections,
Len(clsStrCTLSelections) - 2)
clsStrCTLSQL = clsStrCTLSQL & " AND " & "[" &
clsCTL.Name & "] IN (" & clsStrCTLSelections & ")"
clsIntSelect = clsIntSelect + 1
End If
ElseIf Len(clsStrCTLSQL) < 1 Then
If Len(clsStrCTLSelections) > 0 Then
clsStrCTLSelections = Left(clsStrCTLSelections,
Len(clsStrCTLSelections) - 2)
clsStrCTLSQL = "[" & clsCTL.Name & "] IN (" &
clsStrCTLSelections & ")"
clsIntSelect = clsIntSelect + 1
End If
End If 'End SQL string evaluations
clsStrCTLSelections = ""
End Select 'List Box
Next 'Controls
Next clsIntRecCount 'Recordset
'Close and set the record source to nothing
clsRSTQuery.Close
Set clsRSTQuery = Nothing
'Count the # of records selected
clsVarRecCount = DCount("*", clsStrGetQuery, clsStrCTLSQL)
If Len(clsStrFieldName) > 0 Then
clsStrFieldName = Left(clsStrFieldName, Len(clsStrFieldName) - 2)
'Delete existing records
End If
End Function
'Sets to the current database
Public Property Get clsCurDBName() As Database
Set clsCurDBName = CurrentDb
End Property
Public Property Get clsTotalRecords() As Variant
clsTotalRecords = clsVarRecCount
End Property
Public Function SQLActions()
'INTO " & clsStrTblCreate & " " & _'
Dim clsQDF As QueryDef
Set clsQDF = clsCurDBName.QueryDefs("qryQDF")
' DoCmd.DeleteObject acTable, clsStrTblCreate
'Check to determine if records were selected
If clsIntSelect > 0 Then 'Filtered string
clsStrSQLAction = "SELECT " & clsStrGetQuery & ".* " & _
"FROM " & clsStrGetQuery & " " & _
"WHERE " & clsStrCTLSQL & ""
Else 'No Filter
clsStrSQLAction = "SELECT " & clsStrGetQuery & ".* " & _
"FROM " & clsStrGetQuery & " "
End If
' clsCurDBName.Execute clsStrSQLAction
'DoCmd.RunSQL clsStrSQLAction
clsQDF.SQL = clsStrSQLAction
End Function
Public Function clsSelectAll()
'Select all the entries in a list box for the current form
Dim strCTLFrmName As String
Dim strCurCTLName As String
strCTLFrmName = clsFrmName
Dim varGetCTLLen As Variant
Dim ctlCur As Control
Dim intCtl As Integer
varGetCTLLen = Len(Screen.ActiveControl.Name) - 6
strCurCTLName = "[" & Mid(Screen.ActiveControl.Name, 7, varGetCTLLen) & "]"
For intCtl = 0 To Forms(strCTLFrmName)(strCurCTLName).ListCount - 1
Forms(strCTLFrmName)(strCurCTLName).Selected(intCtl) = True
Next intCtl
End Function
Public Function clsCleartAll()
'Select all the entries in a list box for the current form
Dim strCTLFrmName As String
Dim strCurCTLName As String
strCTLFrmName = clsFrmName
Dim varGetCTLLen As Variant
Dim ctlCur As Control
Dim intCtl As Integer
varGetCTLLen = Len(Screen.ActiveControl.Name) - 6
strCurCTLName = "[" & Mid(Screen.ActiveControl.Name, 7, varGetCTLLen) & "]"
For intCtl = 0 To Forms(strCTLFrmName)(strCurCTLName).ListCount - 1
Forms(strCTLFrmName)(strCurCTLName).Selected(intCtl) = False
Next intCtl
End Function
assist me with this problem. I found a code on the net that works with text
for the filter process, however I am working with integer. I am not sure
how/where to change the code to reflect integer instead of variant. Is it as
simple as replace the word variant with integer? or is it more complex? Any
help big or small would be appreciated. Here is the code where I think I need
to change it to integer:
Option Compare Database
Option Explicit
Public clsVarRecCount As Variant
Public clsStrSQLAction As String
Public clsStrCTLSQL As String
Public clsStrGetQuery As String
Public clsIntSelect As Integer
Dim clsStrTblCreate As String
Public clsStrFieldName As String
Public Property Get clsFrmName() As String
clsFrmName = Screen.ActiveForm.Name
End Property
Public Function RecordSelections()
'Declare the variables
'Form, Controls, and SQL variables
Dim clsFrm As Form
Dim clsStrFrmName As String
Dim clsCTL As Control
Dim clsVarSelection As Variant
Dim clsStrCTLName As String
Dim clsStrCTLChoices As String
Dim clsStrCTLSelections As String
Dim clsStrField As String
'Recordset Variables
Dim clsRSTQuery As New ADODB.Recordset
Dim clsIntRecCount As Integer
Dim clsFieldName As String
Dim varFieldType As Variant
Dim clsvarFinalCount As Variant
clsStrCTLSQL = ""
clsIntSelect = 0
'Set the variables
Set clsFrm = Screen.ActiveForm
clsStrFrmName = Screen.ActiveForm.Name
'Variables to be modified to record source being used
clsStrGetQuery = "MyQuery" 'Change this to the record source that is being
queried on
'Open the record source
clsRSTQuery.Open clsStrGetQuery, CurrentProject.Connection
'Reiterate through the recordset. If field names match the control names on
the form
'then the data type is captured for that field in order to create the
correct syntax
'for the SQL string
For clsIntRecCount = 1 To clsRSTQuery.Fields.Count
clsFieldName = clsRSTQuery(clsIntRecCount - 1).Name
clsStrField = clsRSTQuery(clsIntRecCount - 1).Name & ", "
varFieldType = clsRSTQuery(clsIntRecCount - 1).Type
clsStrFieldName = clsStrFieldName & clsStrField
'Reiterate through the form's control's collection to build SQL strings
For Each clsCTL In clsFrm.Controls
Select Case clsCTL.ControlType
Case acListBox
clsStrCTLName = clsCTL.Name
If clsStrCTLName = clsFieldName Then
Select Case varFieldType 'Determine which syntax to use
Case 2 To 6, 17, 72, 131 'Numeric
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices =
clsCTL.ItemData(clsVarSelection) & ", "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
Case 7 'Date
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices = "#" &
clsCTL.ItemData(clsVarSelection) & "# , "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
Case 202 'Text
For Each clsVarSelection In clsCTL.ItemsSelected
clsStrCTLChoices = "'" &
clsCTL.ItemData(clsVarSelection) & "' , "
clsStrCTLSelections = clsStrCTLSelections &
clsStrCTLChoices
Next 'List box
End Select 'varFieldType
End If 'End control name evaluation
If Len(clsStrCTLSQL) > 0 Then
If Len(clsStrCTLSelections) > 0 Then
clsStrCTLSelections = Left(clsStrCTLSelections,
Len(clsStrCTLSelections) - 2)
clsStrCTLSQL = clsStrCTLSQL & " AND " & "[" &
clsCTL.Name & "] IN (" & clsStrCTLSelections & ")"
clsIntSelect = clsIntSelect + 1
End If
ElseIf Len(clsStrCTLSQL) < 1 Then
If Len(clsStrCTLSelections) > 0 Then
clsStrCTLSelections = Left(clsStrCTLSelections,
Len(clsStrCTLSelections) - 2)
clsStrCTLSQL = "[" & clsCTL.Name & "] IN (" &
clsStrCTLSelections & ")"
clsIntSelect = clsIntSelect + 1
End If
End If 'End SQL string evaluations
clsStrCTLSelections = ""
End Select 'List Box
Next 'Controls
Next clsIntRecCount 'Recordset
'Close and set the record source to nothing
clsRSTQuery.Close
Set clsRSTQuery = Nothing
'Count the # of records selected
clsVarRecCount = DCount("*", clsStrGetQuery, clsStrCTLSQL)
If Len(clsStrFieldName) > 0 Then
clsStrFieldName = Left(clsStrFieldName, Len(clsStrFieldName) - 2)
'Delete existing records
End If
End Function
'Sets to the current database
Public Property Get clsCurDBName() As Database
Set clsCurDBName = CurrentDb
End Property
Public Property Get clsTotalRecords() As Variant
clsTotalRecords = clsVarRecCount
End Property
Public Function SQLActions()
'INTO " & clsStrTblCreate & " " & _'
Dim clsQDF As QueryDef
Set clsQDF = clsCurDBName.QueryDefs("qryQDF")
' DoCmd.DeleteObject acTable, clsStrTblCreate
'Check to determine if records were selected
If clsIntSelect > 0 Then 'Filtered string
clsStrSQLAction = "SELECT " & clsStrGetQuery & ".* " & _
"FROM " & clsStrGetQuery & " " & _
"WHERE " & clsStrCTLSQL & ""
Else 'No Filter
clsStrSQLAction = "SELECT " & clsStrGetQuery & ".* " & _
"FROM " & clsStrGetQuery & " "
End If
' clsCurDBName.Execute clsStrSQLAction
'DoCmd.RunSQL clsStrSQLAction
clsQDF.SQL = clsStrSQLAction
End Function
Public Function clsSelectAll()
'Select all the entries in a list box for the current form
Dim strCTLFrmName As String
Dim strCurCTLName As String
strCTLFrmName = clsFrmName
Dim varGetCTLLen As Variant
Dim ctlCur As Control
Dim intCtl As Integer
varGetCTLLen = Len(Screen.ActiveControl.Name) - 6
strCurCTLName = "[" & Mid(Screen.ActiveControl.Name, 7, varGetCTLLen) & "]"
For intCtl = 0 To Forms(strCTLFrmName)(strCurCTLName).ListCount - 1
Forms(strCTLFrmName)(strCurCTLName).Selected(intCtl) = True
Next intCtl
End Function
Public Function clsCleartAll()
'Select all the entries in a list box for the current form
Dim strCTLFrmName As String
Dim strCurCTLName As String
strCTLFrmName = clsFrmName
Dim varGetCTLLen As Variant
Dim ctlCur As Control
Dim intCtl As Integer
varGetCTLLen = Len(Screen.ActiveControl.Name) - 6
strCurCTLName = "[" & Mid(Screen.ActiveControl.Name, 7, varGetCTLLen) & "]"
For intCtl = 0 To Forms(strCTLFrmName)(strCurCTLName).ListCount - 1
Forms(strCTLFrmName)(strCurCTLName).Selected(intCtl) = False
Next intCtl
End Function