1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
|
Private Sub cmdBuildSchedule_Click()
Dim datThis As Date
Dim lngActID As Long
Dim lngStaffID As Long
Dim lngrojectID As Long
Dim lngOrganizationID As Long
Dim varNotes As Variant
Dim strSQL As String
Dim db As DAO.Database
Dim intDOW As Integer 'day of week
Dim intDIM As Integer 'Day in month
If Me.grpRepeats = 2 Then
If Not CheckDates() Then
Exit Sub
End If
End If
'If Not CheckTimes() Then
' Exit Sub
'End If
If IsNull(Me.cboActID) Then
MsgBox "You must select an Activity.", vbOKOnly + vbInformation, "Enter Activity"
Me.cboActID.SetFocus
Me.cboActID.Dropdown
Exit Sub
End If
If IsNull(Me.cboLocID) Then
MsgBox "You must select a Location.", vbOKOnly + vbInformation, "Enter Location"
Me.cboLocID.SetFocus
Me.cboLocID.Dropdown
Exit Sub
End If
If IsNull(Me.cboOrgID) Then
MsgBox "You must select an organization.", vbOKOnly + vbInformation, "Enter Location"
Me.cboOrgID.SetFocus
Me.cboOrgID.Dropdown
Exit Sub
End If
If IsNull(Me.cboProjectID) Then
MsgBox "You must select a project.", vbOKOnly + vbInformation, "Enter Location"
Me.cboProjectID.SetFocus
Me.cboProjectID.Dropdown
Exit Sub
End If
'strTitle = Me.txtTitle
varNotes = Me.txtNotes
lngStaffID = Me.cboLocID
lngrojectID = cboProjectID
lngOrganizationID = Me.cboOrgID
lngActID = Me.cboActID
Set db = CurrentDb
If Me.grpRepeats = 2 Then 'need to loop through dates
For datThis = Me.txtStartDate To Me.txtEndDate
intDIM = GetDIM(datThis)
intDOW = Weekday(datThis)
If Me("chkDay" & intDIM & intDOW) = True Or _
Me("chkDay0" & intDOW) = True Then
strSQL = "INSERT INTO tblTempSchedDates (" & _
"tscDate, OrgID, ProjectID, tscActID, tscstaffID, " & _
"tscNotes ) " & _
"Values(#" & datThis & "#," & lngOrganizationID & "," & lngrojectID & "," & lngActID & ", " & _
lngStaffID & ", " & _
IIf(IsNull(varNotes), "Null", """" & varNotes & """") & ")"
db.Execute strSQL, dbFailOnError
End If
Next
Else 'dates are there, just add the title, notes, times, location, Activity
strSQL = "Update tblTempSchedDates Set tscActID = " & lngActID & _
", tscstaffID = " & lngStaffID & ", OrgID = " & lngOrganizationID & ", ProjectID = " & lngrojectID
If Len(varNotes & "") > 0 Then
strSQL = strSQL & ", tscNotes = " & IIf(IsNull(varNotes), Null, """" & varNotes & """")
End If
db.Execute strSQL, dbFailOnError
End If
Me.sfrmTempScheduleEdit.Requery
MsgBox "Temporary schedule built. " & _
"You can now edit the schedule and " & _
"append to the permanent schedule.", vbOKOnly + vbInformation, "Temp schedule complete"
End Sub
___________________________________
Function CheckDates() As Boolean
If IsDate(Me.txtStartDate) And IsDate(Me.txtEndDate) Then
CheckDates = True
Else
CheckDates = False
MsgBox "You must enter Start and End dates.", vbOKOnly + vbInformation, "Enter Dates"
End If
End Function
_____________________
Private Sub Form_Open(Cancel As Integer)
Me.grpRepeats.Value = 1
Call grpRepeats_AfterUpdate
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tblTempSchedDates"
DoCmd.SetWarnings True
Me.sfrmTempSchedule.Requery
Me.sfrmTempScheduleEdit.Requery
End Sub
____________________________
Private Sub grpRepeats_AfterUpdate()
Dim ctl As Control
Dim intCounter As Integer
Dim intWeek As Integer
Dim intDay As Integer
Me.txtEndDate.Visible = (Me.grpRepeats = 2)
Me.txtStartDate.Visible = (Me.grpRepeats = 2)
Me.sfrmTempSchedule.Visible = (Me.grpRepeats = 1)
For intWeek = 0 To 5
For intDay = 1 To 7
Set ctl = Me("chkDay" & intWeek & intDay)
ctl.Visible = (Me.grpRepeats = 2)
ctl.Value = 0
Next
Next
Select Case Me.grpRepeats
Case 2 'repeating
Case 1
End Select
End Sub
|
