Code:
Option Compare Database
Option Explicit
Private intYear As Integer
Private intMonth As Integer
Private lngFirstDayOfMonth As Long
Private intLastDayOfLastMonth As Integer
Private intFirstWeekday As Integer
Private intDaysInMonth As Integer
Private strFormReference As String
Private MyArray() As Variant
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim Permission As String
Dim Staff As String
Dim CaseGroup As String
Dim ManagerGroup As String
Dim DepartmentGroup As String
Permission = [Forms]![frmLogin]![txtPermissions]
Staff = [Forms]![frmLogin]![txtStaffNumber]
CaseGroup = [Forms]![frmLogin]![txtCaseGroup]
ManagerGroup = [Forms]![frmLogin]![txtManagerGroup]
DepartmentGroup = [Forms]![frmLogin]![txtDepartmentGroup]
If Permission = "Admin" Then
Me.Caption = "Admin - Calendar"
Me![txtAssignedDeptGroupCalendar].Visible = True
Me![txtAssignedMgrGroupCalendar].Visible = True
Me![txtAssignedCaseGroupCalendar].Visible = True
Me![txtAssignedStaffCalendar].Visible = True
Me![txtSelectMonth] = Month(Date)
Me![txtSelectYear] = Year(Date)
Call Main
ElseIf Permission = "Manager" Then
Me.Caption = "Manager - Calendar"
Me![txtAssignedDeptGroupCalendar].Visible = True
Me![txtAssignedMgrGroupCalendar].Visible = True
Me![txtAssignedCaseGroupCalendar].Visible = True
Me![txtAssignedStaffCalendar].Visible = True
Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
Me![txtAssignedMgrGroupCalendar] = ManagerGroup
Me![txtSelectMonth] = Month(Date)
Me![txtSelectYear] = Year(Date)
Call Main
ElseIf Permission = "User" Then
Me.Caption = "Staff - Calendar"
Me![txtAssignedDeptGroupCalendar].Visible = False
Me![txtAssignedMgrGroupCalendar].Visible = False
Me![txtAssignedCaseGroupCalendar].Visible = False
Me![txtAssignedStaffCalendar].Visible = False
Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
Me![txtAssignedMgrGroupCalendar] = ManagerGroup
Me![txtAssignedCaseGroupCalendar] = CaseGroup
Me![txtAssignedStaffCalendar] = Staff
Me![txtSelectMonth] = Month(Date)
Me![txtSelectYear] = Year(Date)
Call Main
ElseIf Permission = "HR" Then
Me.Caption = "Human Resource - Calendar"
Me![txtAssignedDeptGroupCalendar].Visible = True
Me![txtAssignedMgrGroupCalendar].Visible = True
Me![txtAssignedCaseGroupCalendar].Visible = True
Me![txtAssignedStaffCalendar].Visible = True
Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
Me![txtAssignedMgrGroupCalendar] = ManagerGroup
Me![txtAssignedCaseGroupCalendar] = CaseGroup
Me![txtAssignedStaffCalendar] = Staff
Me![txtSelectMonth] = Month(Date)
Me![txtSelectYear] = Year(Date)
Call Main
ElseIf Nz(Permission, "") = "" Or Nz(Permission, "") = 0 Then
Beep
modEventLog.Tracker "Unauthorized Calendar Access Attempt - Permissions Null or 0"
DoCmd.Quit
ElseIf Permission <> "Admin" Or Permission <> "Manager" Or Permission <> "User" Or Permission <> "HR" Then
Beep
modEventLog.Tracker "Unauthorized Calendar Access Attempt - Permissions Not Recognized"
DoCmd.Quit
End If
ErrorHandler_Exit:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ErrorHandler_Exit
End Sub
Private Sub txtAssignedDeptGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT DepartmentGroupName FROM tlkpDepartmentGroup ORDER BY DepartmentGroupName ASC "
Me![txtAssignedDeptGroupCalendar].RowSource = strSQL
Me![txtAssignedDeptGroupCalendar].Requery
End Sub
Private Sub txtAssignedMgrGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT ManagerGroupName FROM tlkpManagerGroup ORDER BY ManagerGroupName ASC "
Me![txtAssignedMgrGroupCalendar].RowSource = strSQL
Me![txtAssignedMgrGroupCalendar].Requery
End Sub
Private Sub txtAssignedCaseGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT CaseGroupName FROM tlkpCaseGroup ORDER BY CaseGroupName ASC "
Me![txtAssignedCaseGroupCalendar].RowSource = strSQL
Me![txtAssignedCaseGroupCalendar].Requery
End Sub
Private Sub txtAssignedStaffCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT StaffNum, CompanyName, FirstName, LastName FROM tblStaff ORDER BY StaffNum ASC "
Me![txtAssignedStaffCalendar].RowSource = strSQL
Me![txtAssignedStaffCalendar].Requery
End Sub
Private Sub txtSelectMonth_Click()
On Error GoTo ErrorHandler
Call Main
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtSelectYear_AfterUpdate()
On Error GoTo ErrorHandler
Call Main
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Public Sub Main()
On Error GoTo ErrorHandler
Call InitVariables
Call InitArray
Call LoadArray
Call PrintArray
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Public Sub InitVariables()
On Error GoTo ErrorHandler
intYear = Me![txtSelectYear]
intMonth = Me![txtSelectMonth]
lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
intDaysInMonth = getDaysInMonth(lngFirstDayOfMonth)
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Public Sub InitArray()
On Error GoTo ErrorHandler
Dim i As Integer
ReDim MyArray(0 To 41, 0 To 3)
For i = 0 To 41
MyArray(i, 0) = lngFirstDayOfMonth + 1 - intFirstWeekday + i
If Month(MyArray(i, 0)) = intMonth Then
MyArray(i, 1) = True
MyArray(i, 2) = i + 2 - intFirstWeekday & vbNewLine
Else
MyArray(i, 1) = False
End If
Next i
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Public Sub LoadArray()
On Error GoTo ErrorHandler
Dim db As Database
Dim rs As Recordset
Dim rsFiltered As Recordset
Dim strSQL As String
Dim i As Integer
strSQL = "SELECT tblCalendarData.CalendarDate, tblCalendarData.CalendarTime, tblCalendarData.ActivityNumber, tblCalendarData.CalendarCity, tblCalendarData.CalendarState, tblCalendarData.StaffNum, tblCalendarData.AssignedCaseGroup, tblCalendarData.AssignedManagerGroup, tblCalendarData.AssignedDepartmentGroup " _
& "FROM tblCalendarData " _
& "WHERE tblCalendarData.[AssignedDepartmentGroup] = '" & Me.txtAssignedDeptGroupCalendar & "' AND tblCalendarData.[AssignedManagerGroup] = '" & Me.txtAssignedMgrGroupCalendar & "' AND tblCalendarData.[AssignedCaseGroup] = '" & Me.txtAssignedCaseGroupCalendar & "' AND tblCalendarData.[StaffNum] = '" & Me.txtAssignedStaffCalendar & "' " _
& "ORDER BY tblCalendarData.CalendarDate "
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
With rs
If Not rs.BOF And Not rs.EOF Then
For i = 0 To UBound(MyArray)
If MyArray(i, 1) = True Then
.Filter = "[CalendarDate]=" & MyArray(i, 0)
Set rsFiltered = .OpenRecordset
If Not rsFiltered.BOF And Not rsFiltered.EOF Then
Do While Not rsFiltered.EOF = True
MyArray(i, 2) = MyArray(i, 2) & vbNewLine & rsFiltered!CalendarTime
MyArray(i, 2) = MyArray(i, 2) & " - " & rsFiltered!ActivityNumber
MyArray(i, 2) = MyArray(i, 2) & " " & rsFiltered!CalendarCity
MyArray(i, 2) = MyArray(i, 2) & " " & rsFiltered!CalendarState
rsFiltered.MoveNext
Loop
End If
End If
Next i
End If
.Close
End With
ExitSub:
Set db = Nothing
Set rs = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Public Sub PrintArray()
On Error GoTo ErrorHandler
Dim strTextBox As String
Dim i As Integer
For i = 0 To 41
strTextBox = "txtbox" & CStr(i + 1)
With Me
Controls(strTextBox) = ""
Controls(strTextBox).Tag = i + 1
Controls(strTextBox) = MyArray(i, 2)
End With
Next i
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub OpenContinuousForm(ctlName As String)
On Error GoTo ErrorHandler
Dim ctlValue As Integer
Dim DayOfMonth As Long
ctlValue = Me.Controls(ctlName).Tag
DayOfMonth = MyArray(ctlValue - 1, 0)
DoCmd.OpenForm "frmCalendarData", acNormal, , "[CalendarDate]=" & DayOfMonth
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox1_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox2_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox3_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox4_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox5_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox6_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox7_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox8_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox9_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox10_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox11_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox12_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox13_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox14_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox15_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox16_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox17_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox18_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox19_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox20_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox21_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox22_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox23_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox24_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox25_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox26_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox27_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox28_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox29_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox30_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox31_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox32_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox33_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox34_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox35_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox36_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox37_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox38_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox39_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox40_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox41_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtbox42_Click()
On Error GoTo ErrorHandler
If Me.ActiveControl.text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbOKOnly, ""
Resume ExitSub
End Sub
Private Sub txtSelectDeptGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT DepartmentGroupName FROM tlkpDepartmentGroup ORDER BY ID "
Me![txtSelectDeptGroupCalendar].RowSource = strSQL
Me![txtSelectDeptGroupCalendar].Requery
End Sub
Private Sub txtSelectMgrGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT ManagerGroupName FROM tlkpManagerGroup ORDER BY ID "
Me![txtSelectMgrGroupCalendar].RowSource = strSQL
Me![txtSelectMgrGroupCalendar].Requery
End Sub
Private Sub txtSelectCaseGroupCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT CaseGroupName FROM tlkpCaseGroup ORDER BY ID "
Me![txtSelectCaseGroupCalendar].RowSource = strSQL
Me![txtSelectCaseGroupCalendar].Requery
End Sub
Private Sub txtSelectStaffCalendar_GotFocus()
Dim strSQL As String
strSQL = "SELECT StaffNum, CompanyName, FirstName, LastName FROM tblStaff ORDER BY ID "
Me![txtSelectStaffCalendar].RowSource = strSQL
Me![txtSelectStaffCalendar].Requery
End Sub
Private Sub btnPreviousMonth_Click()
On Error GoTo btnPreviousMonth_Click_Err
Dim January, February, March, April, May, June, July, August, September, October, November, December
January = 1
February = 2
March = 3
April = 4
May = 5
June = 6
July = 7
August = 8
September = 9
October = 10
November = 11
December = 12
If Me![txtSelectMonth] = 2 - 1 Then
Me![txtSelectMonth] = 12
Me![txtSelectYear] = Me![txtSelectYear] - 1
Else
Me![txtSelectMonth] = Me![txtSelectMonth] - 1
End If
btnPreviousMonth_Click_Exit:
Exit Sub
btnPreviousMonth_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnPreviousMonth_Click_Exit
End Sub
Private Sub btnNextMonth_Click()
On Error GoTo btnNextMonth_Click_Err
Dim January, February, March, April, May, June, July, August, September, October, November, December
January = 1
February = 2
March = 3
April = 4
May = 5
June = 6
July = 7
August = 8
September = 9
October = 10
November = 11
December = 12
If Me![txtSelectMonth] = 11 + 1 Then
Me![txtSelectMonth] = 1
Me![txtSelectYear] = Me![txtSelectYear] + 1
Else
Me![txtSelectMonth] = Me![txtSelectMonth] + 1
End If
btnNextMonth_Click_Exit:
Exit Sub
btnNextMonth_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnNextMonth_Click_Exit
End Sub
Private Sub btnRefresh_Click()
On Error GoTo btnRefresh_Click_Err
Call Form_Load
btnRefresh_Click_Exit:
Exit Sub
btnRefresh_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnRefresh_Click_Exit
End Sub
Private Sub btnCalendarClose_Click()
On Error GoTo btnCalendarClose_Click_Err
If Me.Dirty Then
DoCmd.RunCommand acCmdUndo
Else
DoCmd.Close acForm, Me.Name
End If
DoCmd.Close acForm, Me.Name
btnCalendarClose_Click_Exit:
Exit Sub
btnCalendarClose_Click_Err:
MsgBox Err.Description, vbOKOnly, ""
Resume btnCalendarClose_Click_Exit
End Sub
Code:
Option Compare Database
Private Sub Form_Load()
Me![txtAssignedDeptGroupCalendar] = [Forms]![frmCalendar]![txtAssignedDeptGroupCalendar]
Me![txtAssignedMgrGroupCalendar] = [Forms]![frmCalendar]![txtAssignedMgrGroupCalendar]
Me![txtAssignedCaseGroupCalendar] = [Forms]![frmCalendar]![txtAssignedCaseGroupCalendar]
Me![txtAssignedStaffCalendar] = [Forms]![frmCalendar]![txtAssignedStaffCalendar]
End Sub
Private Sub btnAdd_Click()
On Error GoTo btnAdd_Click_Err
DoCmd.GoToRecord , "", acNewRec
btnAdd_Click_Exit:
Exit Sub
btnAdd_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnAdd_Click_Exit
End Sub
Private Sub btnSave_Click()
On Error GoTo btnSave_Click_Err
If Me.Dirty = False Then
Beep
MsgBox "Nothing to Save.", , ""
Else
DoCmd.RunCommand acCmdSaveRecord
End If
btnSave_Click_Exit:
Exit Sub
btnSave_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnSave_Click_Exit
End Sub
Private Sub btnUndo_Click()
On Error GoTo btnUndo_Click_Err
If Me.Dirty Then
DoCmd.RunCommand acCmdUndo
Else
Beep
MsgBox "Nothing to Undo.", , ""
End If
btnUndo_Click_Exit:
Exit Sub
btnUndo_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnUndo_Click_Exit
End Sub
Private Sub btnDelete_Click()
On Error GoTo btnDelete_Click_Err
DoCmd.GoToControl Screen.PreviousControl.Name
Err.Clear
If (Not Form.NewRecord) Then
DoCmd.RunCommand acCmdDeleteRecord
ElseIf (Form.NewRecord And Form.Dirty) Then
DoCmd.RunCommand acCmdUndo
End If
btnDelete_Click_Exit:
Exit Sub
btnDelete_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnDelete_Click_Exit
End Sub
Private Sub btnCalendarDataClose_Click()
On Error GoTo btnCalendarDataClose_Click_Err
DoCmd.Close acForm, Me.Name
Forms!frmCalendar.btnRefresh.SetFocus
SendKeys "{ENTER}"
btnCalendarDataClose_Click_Exit:
Exit Sub
btnCalendarDataClose_Click_Err:
MsgBox Err.Description, vbOKOnly, ""
Resume btnCalendarDataClose_Click_Exit
End Sub
Private Sub btnFirstRecord_Click()
On Error GoTo btnFirstRecord_Click_Err
DoCmd.GoToRecord , "", acFirst
btnFirstRecord_Click_Exit:
Exit Sub
btnFirstRecord_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnFirstRecord_Click_Exit
End Sub
Private Sub btnPreviousRecord_Click()
On Error GoTo btnPreviousRecord_Click_Err
On Error Resume Next
DoCmd.GoToRecord , "", acPrevious
btnPreviousRecord_Click_Exit:
Exit Sub
btnPreviousRecord_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnPreviousRecord_Click_Exit
End Sub
Private Sub btnNextRecord_Click()
On Error GoTo btnNextRecord_Click_Err
On Error Resume Next
DoCmd.GoToRecord , "", acNext
btnNextRecord_Click_Exit:
Exit Sub
btnNextRecord_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnNextRecord_Click_Exit
End Sub
Private Sub btnLastRecord_Click()
On Error GoTo btnLastRecord_Click_Err
DoCmd.GoToRecord , "", acLast
btnLastRecord_Click_Exit:
Exit Sub
btnLastRecord_Click_Err:
Beep
MsgBox Err.Description, vbOKOnly, ""
Resume btnLastRecord_Click_Exit
End Sub