Option Compare Database
Option Explicit
Option Base 0
'Constant declarations.
Private Const CAPTION_DEFAULT = "Please select an action to review."
Private Const ACTION_DEFAULT = "All Actions"
Private Const USER_DEFAULT = "All Users"
Private Const SQL_SELECT = "SELECT dbo_tblActivityLog.ActivityID, " & _
"dbo_tblActivityLog.ActionID, " & _
"dbo_tblActivityLog.UserID, " & _
"Format([ActivityDate],'Short Date') AS [Date], " & _
"Format([ActivityDate],'h:mm AMPM') AS [Time], " & _
"dbo_tblActions.ActionName "
Private Const SQL_FROM = "FROM dbo_tblActions " & _
"INNER JOIN dbo_tblActivityLog ON dbo_tblActions.ActionID = dbo_tblActivityLog.ActionID "
Private Const SQL_ORDERBY = "ORDER BY dbo_tblActivityLog.ActivityDate DESC;"
Private Sub cmdFilter_Click()
Dim SQL As String
Dim sqlWhere As String
'Determine if a filter is actually needed.
If Me.optDateRange = 1 And Me.cboActions = 0 And Me.cboUsers = USER_DEFAULT Then
MsgBox "Filter values must be set before a filter can be applied.", vbInformation, AppTitle
'Determine if txtFromDate is greater than txtToDate.
ElseIf Me.txtFromDate > Me.txtToDate Then
MsgBox "From date must be less than or equal to the To date.", vbInformation, AppTitle
Else
'Determine if the user selected the 'Date Range' option in the Date Range option group.
If Me.optDateRange.Value = 2 Then
'Determine if either txtFromDate or txtToDate were left blank.
If IsNull(Me.txtFromDate.Value) Or IsNull(Me.txtToDate.Value) Then
'Notify the user to either enter both dates or select a different option.
MsgBox "Please enter both a start and a finish date, or select another date range option.", vbInformation, AppTitle
'Abort the procedure.
Exit Sub
End If
End If
'Execute CreateWhere to generate the WHERE statement needed for the selected filter.
sqlWhere = CreateWhere()
'Assemble the SQL statement that will be the new recordsource for lstActivityLog.
SQL = SQL_SELECT & SQL_FROM & sqlWhere & SQL_ORDERBY
'Assign the string in SQL to be the new recordsource of lstActionLog.
Me.lstActionLog.RowSource = SQL
'Show lblFilter.
Me.lblFilter.Visible = True
End If
End Sub
Private Function CreateWhere() As String
' ************************************************************
' Created by : Scott L. Prince
' Parameters : None
' Results : Determines the necessary WHERE clause to limit lstActionList to user-selected parameters
' Returns : String containing SQL WHERE clause
' Date : 4-11-2014
' Remarks :
' Changes :
' ************************************************************
On Error GoTo CreateWhere_Err
Dim ActionID As Long
Dim DateFrom As Date
Dim DateTo As Date
Dim RangeType As Long
Dim TempWhere As String
Dim User As String
'Pull filter selections.
User = Me.cboUsers.Value
ActionID = Me.cboActions.Value
RangeType = Me.optDateRange.Value
'Begin the WHERE statement.
TempWhere = "WHERE ("
'If a specific user has been selected, add them to the WHERE statement.
If User <> USER_DEFAULT Then TempWhere = TempWhere & "((dbo_tblActivityLog.UserID) = '" & User & "') "
'Determine if the user is filtering on cboActions.
If ActionID <> 0 Then
'If TempWhere has changed from "WHERE ", add "AND ".
If TempWhere <> "WHERE (" Then TempWhere = TempWhere & "AND "
'Add the selected ActionID to the WHERE criteria.
TempWhere = TempWhere & "((dbo_tblActivityLog.ActionID) = " & ActionID & ") "
End If
'Determine DateFrom and DateTo based on value of rangetype.
Select Case RangeType
Case 1 'All dates
'Strip the space at the end of TempWhere and append ") " to close out the WHERE clause.
TempWhere = RTrim(TempWhere) & ") "
Case 2 'Specified range
'Set DateTo to tomorrow. (Access SQL doesn't include the final argument of a BETWEEN statement.)
DateTo = DateAdd("d", 1, Date)
'Determine which range was selected in order to determine DateFrom.
Select Case Me.cboDateRange.Value
Case 1 '30 days
DateFrom = DateAdd("d", -30, Date)
Case 2 '90 days
DateFrom = DateAdd("d", -90, Date)
Case 3 '6 months
DateFrom = DateAdd("m", -6, Date)
Case 4 '1 year
DateFrom = DateAdd("yyyy", -1, Date)
End Select
'If TempWhere has changed from "WHERE ", add "AND ".
If TempWhere <> "WHERE (" Then TempWhere = TempWhere & "AND "
'Add the selected date range to TempWhere.
TempWhere = TempWhere & "((dbo_tblActivityLog.ActivityDate) Between #" & DateFrom & "# And #" & DateTo & "#)) "
Case 3 'Provided dates
'Pull the values for DateFrom and DateTo from the user-entered values in txtFromDate and txtToDate.
'One day is added to DateTo because Access SQL excludes the second argument of BETWEEN.
DateFrom = Me.txtFromDate.Value
DateTo = DateAdd("d", 1, Me.txtToDate.Value)
'If TempWhere has changed from "WHERE ", add "AND ".
If TempWhere <> "WHERE (" Then TempWhere = TempWhere & "AND "
'Add the selected date range to TempWhere.
TempWhere = TempWhere & "((dbo_tblActivityLog.ActivityDate) Between #" & DateFrom & "# And #" & DateTo & "#)) "
End Select
'Return the WHERE string.
CreateWhere = TempWhere
CreateWhere_Exit:
Exit Function
CreateWhere_Err:
MsgBox "Error occurred" & vbCrLf & vbCrLf & _
"In Function:" & vbTab & "CreateWhere" & vbCrLf & _
"Err Number: " & vbTab & Err.Number & vbCrLf & _
"Description: " & vbTab & Err.Description, vbCritical, AppTitle
Resume CreateWhere_Exit
End Function
