66
Loading of Subjects [Link](2) = "0/" & pbtotal
sqlquery = "select
Dim AMDayTime(0 To 6) As DAYTIME distinct(blockcode),session,degreecode,year
Dim PMDayTime(0 To 6) As DAYTIME from block order by year desc;"
Dim fullLoad As Boolean Set results =
Dim currentDays As String 'stores [Link](sqlquery,
the current days for scheduling rdOpenStatic, rdConcurRowVer,
Dim currentTimes As String 'stores rdExecDirect)
the current times for scheduling With results
Dim currentUnits As Integer 'stores pbCount = 0
the unit of a course Do While Not .EOF
Dim currentSubject As Integer [Link] = CInt((pbCount
'identifies the current course being / pbtotal) * 100)
scheduled based on the array of courses [Link](2) = pbCount &
derived from the curriculum "/" & pbtotal
Dim totalSubjects As Integer 'tells the timePointer = 0
total number of courses for a specific InitializeDayTime
curriculum part
Dim subjects() As CURRCOURSES noCurriculum = True
'array of subjects for a particular curriculum sqlquery = "select * from curriculum
Dim ThisBlock As Boolean 'tells where sem='" &
whether a schedule for the current block has [Link](1) & "'and
been created year='" & !Year & "' and degreecode='" & !
Dim UseThisFaculty As Boolean 'tells degreecode & "';"
whether a faculty should be scheduled for Set Results2 =
an entry [Link](sqlquery,
Dim timePointer As Integer rdOpenStatic, rdConcurRowVer,
Dim noFaculty As Boolean rdExecDirect)
Dim noCurriculum As Boolean With Results2
Dim DesignationUnits As Integer totalSubjects = 0
Dim pbCount As Integer Do While Not .EOF
Dim pbtotal As Integer noCurriculum = False
Dim startHere As Integer totalSubjects = totalSubjects +
Dim results As rdoResultset 1
.MoveNext
Private Sub cmdCreateSched_Click() Loop
Dim a As String .Close
Dim b As String End With
Dim c As String
ConnectToMySQL If noCurriculum Then GoTo
NOCURRICULUMSET
sqlquery = "select
distinct(COUNT(blockcode)) as counted ReDim subjects(0 To (totalSubjects -
from block;" 1)) 'Redeclares the array to proper
Set results = dimension
[Link](sqlquery,
rdOpenStatic, rdConcurRowVer, sqlquery = "select coursecode from
rdExecDirect) curriculum where sem='" &
With results [Link](1) & "'and
Do While Not .EOF year='" & !Year & "' and degreecode='" & !
pbtotal = !counted degreecode & "';"
.MoveNext Set Results2 =
Loop [Link](sqlquery,
.Close rdOpenStatic, rdConcurRowVer,
End With rdExecDirect)
[Link] = 100 With Results2
67
currentSubject = 0 currentSubject = i
Do While Not .EOF Exit For
subjects(currentSubject).sched End If
uled = False Next i
subjects(currentSubject).subject
Code = Results2!coursecode startHere = 0
currentSubject = currentSubject noFaculty = True
+1 sqlquery = "select * from
.MoveNext handledcourse where
Loop ([Link]='" &
.Close subjects(currentSubject).subjectCode & "')
End With and rank<>'Contractual';"
'[Link] = '3' ;"
For i = 0 To totalSubjects - 1 Set Results2 =
sqlquery = "select * from subject [Link](sqlquery,
where coursecode='" & rdOpenStatic, rdConcurRowVer,
subjects(i).subjectCode & "';" rdExecDirect)
Set Results2 = With Results2
[Link](sqlquery, Do While Not .EOF
rdOpenStatic, rdConcurRowVer, noFaculty = False
rdExecDirect) UseThisFaculty = True
With Results2 'get the names of faculty
Do While Not .EOF sqlquery = "select
subjects(i).level = !level lname,fname,middle from faculty where
'the level of a course facultycode='" & Results2!facultycode & "';"
subjects(i).units = !unit Set results6 =
'the unit of a course [Link](sqlquery,
subjects(i).description = ! rdOpenStatic, rdConcurRowVer,
description rdExecDirect)
subjects(i).lab = !lab With results6
subjects(i).lect = !lecture Do While Not .EOF
Exit Do a = results6!lname
b = results6!fname
.MoveNext c = results6!middle
Loop
.Close
End With .MoveNext
Next i Loop
.Close
fullLoad = False End With
ThisBlock = False
currentSubject = 0 'check if faculty is active or
on-leave
Do While Not ThisBlock sqlquery = "select * from
If !Session = "AM" Then facultystatus where facultycode=" & !
'initialize daytime facultycode & " and status<>'ACTIVE';"
currentDays = Set results3 =
AMDayTime(timePointer).days [Link](sqlquery,
currentTimes = rdOpenStatic, rdConcurRowVer,
AMDayTime(timePointer).times rdExecDirect)
With results3
'check for level 2 course and Do While Not .EOF
then prioritize it for scheduling UseThisFaculty =
For i = 0 To totalSubjects - 1 False
If subjects(i).level <= 2 And .MoveNext
subjects(i).scheduled = False Then Loop
68
With results3 'insert in schedule
Do While Not .EOF sqlquery = "insert into
UseThisFaculty schedule (degreecode, blockcode, sem,
= False acadyear, coursecode, days, times,
.MoveNext facultycode) " & _
Loop "values ('" &
.Close results!degreecode & "', '" &
End With results!blockcode & "', '" &
[Link](1) & "', '" &
[Link](2) & "', '" & !
'check for overloading coursecode & "', '" & currentDays & "', '" &
If UseThisFaculty Then currentTimes & "', " & !facultycode & ");"
DesignationUnits = 0 MySQLConnection.E
xecute sqlquery, rdExecDirect
sqlquery = "select 'update faculty's load
SUM(unit) as adminLoad from designation, sqlquery = "update
facultydesignation where facultycode=" & ! facultyload set unitload=unitload+" &
facultycode & " and subjects(currentSubject).units & " where
[Link]=[Link] facultycode=" & !facultycode & ";"
group by facultycode;" MySQLConnection.E
Set results3 = xecute sqlquery, rdExecDirect
[Link](sqlquery, 'update faculty's
rdOpenStatic, rdConcurRowVer, schedule
rdExecDirect) sqlquery = "insert into
With results3 facultysched
Do While Not .EOF (facultycode,lname,fname,mname, sem,
DesignationUnits acadyear, days, times, coursecode,
= !adminLoad description,unit,lab,lecture,block) values (" &
.MoveNext !facultycode & ",'" & a & "','" & b & "','" & c &
Loop "', '" & [Link](1) & "', '"
.Close & [Link](2) & "', '" &
End With currentDays & "', '" & currentTimes & "', '" &
subjects(currentSubject).subjectCode & "', '"
sqlquery = "select * & subjects(currentSubject).description & "','"
from facultyload where facultycode=" & ! & subjects(currentSubject).units & "','" &
facultycode & " and (unitload + " & subjects(currentSubject).lab & "','" &
subjects(currentSubject).units & " + " & subjects(currentSubject).lect & "','" &
DesignationUnits & ")=18;" results!blockcode & "' );"
Set results3 = MySQLConnection.E
[Link](sqlquery, xecute sqlquery, rdExecDirect
rdOpenStatic, rdConcurRowVer,
rdExecDirect) 'tell that the subject
With results3 has been scheduled and the daytime used
Do While Not .EOF subjects(currentSubje
UseThisFaculty ct).scheduled = True
= False PMDayTime(timePoin
.MoveNext ter).units = subjects(currentSubject).units
Loop If
fullLoad = True subjects(currentSubject).level = 6 Then
.Close PMDayTime(timeP
End With ointer + 1).used = True
End If
End If
If fullLoad Then
'insert in the schedule checkConFaculty1PM
If UseThisFaculty Then End If
69
If noFaculty Then Exit For
'leave the course blank in End If
the schedule since no faculty and daytime Next i
matched the need End If
sqlquery = "insert into
schedule (degreecode, blockcode, sem, ThisBlock = True
acadyear, coursecode, days, times, 'assumes that a schedule for a block has
facultycode) " & _ been successfuly created
"values ('" & For i = 0 To totalSubjects - 1
results!degreecode & "', '" & If subjects(i).scheduled = False
results!blockcode & "', '" & Then
[Link](1) & "', '" & ThisBlock = False
[Link](2) & "', '" & 'tells that the block still have courses not
subjects(currentSubject).subjectCode & "', ' scheduled
', ' ', 0);" Exit For
[Link] End If
e sqlquery, rdExecDirect Next i
subjects(currentSubject).s
cheduled = True If ThisBlock Then
End If timePointer = 0
InitializeDayTime
If End If
subjects(currentSubject).scheduled = False
Then Loop 'end loop for block scheduling
sqlquery = "insert into
schedule (degreecode, blockcode, sem,
acadyear, coursecode, days, times, NOCURRICULUMSET:
facultycode) " & _ pbCount = pbCount + 1
"values ('" & .MoveNext
results!degreecode & "', '" & Loop
results!blockcode & "', '" & .Close
[Link](1) & "', '" & End With
[Link](2) & "', '" & [Link]
subjects(currentSubject).subjectCode & "', ' [Link] = 100
', ' ', 0);" [Link](2) = pbtotal & "/" &
[Link] pbtotal
e sqlquery, rdExecDirect MsgBox "Scheduling done!",
subjects(currentSubject).s vbInformation
cheduled = True UpdateMsf3
End If End Sub
Function checkConFaculty1PM()
'move the subject pointer to sqlquery = "select * from
the next subject handledcourse where
For i = 0 To totalSubjects - 1 ([Link]='" &
If subjects(i).scheduled = subjects(currentSubject).subjectCode & "')
False Then and rank='Contractual';" 'and
currentSubject = i [Link] = '3'
Exit For Set results11 =
End If [Link](sqlquery,
Next i rdOpenStatic, rdConcurRowVer,
For i = 0 To 6 rdExecDirect)
If PMDayTime(i).used = With results11
False Then Do While Not .EOF
'move the daytime noFaculty = False
pointer to the next slot UseThisFaculty = True
timePointer = i 'get the names of faculty
70
sqlquery = "select Loop
lname,fname,middle from faculty where .Close
facultycode='" & results11!facultycode & "';" End With
Set results6 =
[Link](sqlquery, 'check conflict
rdOpenStatic, rdConcurRowVer, sqlquery = "select * from
rdExecDirect) facultysched where block='" &
With results6 results!blockcode & "' and days='" &
Do While Not .EOF currentDays & "' and times='" &
a = results6!lname currentTimes & "';"
b = results6!fname Set results3 =
c = results6!middle [Link](sqlquery,
rdOpenStatic, rdConcurRowVer,
rdExecDirect)
.MoveNext With results3
Loop Do While Not .EOF
.Close UseThisFaculty =
End With False
.MoveNext
'check if faculty is active or Loop
on-leave .Close
sqlquery = "select * from End With
facultystatus where facultycode=" & !
facultycode & " and status<>'ACTIVE';" 'check conflict
Set results3 = sqlquery = "select * from
[Link](sqlquery, facultysched where coursecode = '" & !
rdOpenStatic, rdConcurRowVer, coursecode & "' and block='" &
rdExecDirect) results!blockcode & "';"
With results3 Set results3 =
Do While Not .EOF [Link](sqlquery,
UseThisFaculty = rdOpenStatic, rdConcurRowVer,
False rdExecDirect)
.MoveNext With results3
Loop Do While Not .EOF
.Close UseThisFaculty =
End With False
.MoveNext
'check for conflict in Loop
schedule .Close
sqlquery = "select * from End With
facultysched where facultycode = " &
results11!facultycode & " And sem = '" & 'check for overloading
[Link](1) & "' And If UseThisFaculty Then
acadYear = " & DesignationUnits = 0
[Link](2) & " And (days
= '" & currentDays & "' And times = '" & sqlquery = "select
currentTimes & "');" SUM(unit) as adminLoad from designation,
Set results3 = facultydesignation where facultycode=" & !
[Link](sqlquery, facultycode & " and
rdOpenStatic, rdConcurRowVer, [Link]=[Link]
rdExecDirect) group by facultycode;"
With results3 Set results3 =
Do While Not .EOF [Link](sqlquery,
UseThisFaculty = rdOpenStatic, rdConcurRowVer,
False rdExecDirect)
.MoveNext With results3
71
Do While Not .EOF AMDayTime(4).times = "7:30-9:00"
DesignationUnits AMDayTime(4).units = 0
= !adminLoad AMDayTime(4).used = False
.MoveNext
Loop AMDayTime(5).days = "TTh"
.Close AMDayTime(5).times = "9:00-10:30"
End With AMDayTime(5).units = 0
AMDayTime(5).used = False
sqlquery = "select * from
facultyload where facultycode=" & ! AMDayTime(6).days = "TTh"
facultycode & " and (unitload + " & AMDayTime(6).times = "10:30-12:00"
subjects(currentSubject).units & " + " & AMDayTime(6).units = 0
DesignationUnits & ")>27;" AMDayTime(6).used = False
Set results3 =
[Link](sqlquery,
rdOpenStatic, rdConcurRowVer, PMDayTime(0).days = "MWF"
rdExecDirect) PMDayTime(0).times = "1:00-2:00"
With results3 PMDayTime(0).units = 0
Do While Not .EOF PMDayTime(0).used = False
UseThisFaculty =
False PMDayTime(1).days = "MWF"
fullLoad = True PMDayTime(1).times = "2:00-3:00"
.MoveNext PMDayTime(1).units = 0
Loop PMDayTime(1).used = False
.Close
End With PMDayTime(2).days = "MWF"
End If PMDayTime(2).times = "3:00-4:00"
'insert in the schedule PMDayTime(2).units = 0
If UseThisFaculty Then PMDayTime(2).used = False
'insert in schedule
sqlquery = "insert into PMDayTime(3).days = "MWF"
schedule (degreecode, blockcode, sem, PMDayTime(3).times = "4:00-5:00"
acadyear, coursecode, days, times, PMDayTime(3).units = 0
facultycode) " & _ PMDayTime(3).used = False
"values ('" &
results!degreecode & "', '" & PMDayTime(4).days = "TTh"
results!blockcode & "', '" & PMDayTime(4).times = "1:00-2:30"
[Link](1) & "', '" & PMDayTime(4).units = 0
[Link](2) & "', '" & ! PMDayTime(4).used = False
coursecode & "', '" & currentDays & "', '" &
currentTimes & "', " & !facultycode & ");" PMDayTime(5).days = "TTh"
MySQLConnection.E PMDayTime(5).times = "2:30-4:00"
xecute sqlquery, rdExecDirect PMDayTime(5).units = 0
'update faculty's load PMDayTime(5).used = False
sqlquery = "update
facultyload set unitload=unitload+" & PMDayTime(6).days = "TTh"
subjects(currentSubject).units & " where PMDayTime(6).times = "4:00-5:30"
facultycode=" & !facultycode & ";" PMDayTime(6).units = 0
PMDayTime(6).used = False
End Function
AMDayTime(3).days = "MWF"
AMDayTime(3).times = "10:30-11:30"
AMDayTime(3).units = 0
AMDayTime(3).used = False Private Sub Form_Load()
Updatemsf1
AMDayTime(4).days = "TTh" UpdateMsf2
72
Dim row As Integer
End Sub RefreshSchedule
row = 1
ConnectToMySQL
Public Sub UpdateMsf2()
Dim row As Integer sqlquery = "select * from schedule where
facultycode<>'0' and sem='" &
row = 1 [Link](1) & "' And
acadyear ='" &
[Link] = 2 [Link](2) & "';"
ConnectToMySQL Set result =
sqlquery = "select * from subject" [Link](sqlquery,
Set result = rdOpenStatic, rdConcurRowVer,
[Link](sqlquery, rdExecDirect)
rdOpenStatic, rdConcurRowVer, With result
rdExecDirect) Do While Not .EOF
With result If row >= [Link] Then [Link]
Do While Not .EOF = [Link] + 1
If row >= [Link] Then [Link] [Link](row, 0) = !
= [Link] + 1 degreecode
[Link](row, 0) = !coursecode [Link](row, 1) = !blockcode
[Link](row, 1) = !description [Link](row, 2) = !coursecode
row = row + 1 [Link](row, 3) = !facultycode
.MoveNext [Link](row, 4) = !days
Loop [Link](row, 5) = !times
[Link](row, 6) = !sem
End With [Link](row, 7) = !acadYear
row = row + 1
[Link] .MoveNext
End Sub Loop
Sub Updatemsf1() End With
Dim row As Integer
[Link]
row = 1 End Sub
[Link] = 2
ConnectToMySQL
sqlquery = "select * from faculty"
Set result =
[Link](sqlquery,
rdOpenStatic, rdConcurRowVer,
rdExecDirect)
[Link]
End Sub
Sub RefreshSchedule()
[Link]
[Link] = 2
[Link] = "Degree Code |^
Block Code |^ Course Code |^
Faculty Code |^ Day |^ Time
|^ Sem |^ Academic Year "
End Sub
Sub UpdateMsf3()