Solved

vb timetable scheduling

Posted on 2006-11-13
2
653 Views
Last Modified: 2013-12-25
Hi all,

ive inhereted a system which works out appointments for students and uses vb in access to automatically schedule these appointments. (code pasted below).

it works on a token system - if a child wants to see a teacher you set a 'requested' field to 'yes' then copies that info linked to the teacher info into a timeslot in a new table.

what i need to do is amend it in one of the following two ways.

either i need to set it so more than one pupil can see a teacher at any one time- as it stands the pupils can only visit it one at a time for a five min slot- i wanna change that to up to 15 kids for a 20 minute slot....

or (and this is probably easier) program 1 minute appointments with 20 minute gaps- and the gaps must be inforced.

here's why- at the moment the code is taking the selected appointments and scheduling them in within the start and end times into 5 minute slots- the new event im running has 20 minute slots yet can have mutilple attendees so need to change the elements of the code to allow for this.

therefore i can either make the appointments have multiple attendees (don't know how!)- think this would involve a complete overhaul of the code

or make the appointments 1 minute long but increase the gap between them to 20 minutes- this means the appointments can only have one attendee but there will be 20 within 20 minutes- this is probably easier

hope this make sense- can anyone help?

greg


[vbcode]
'===================================================================================================
Private Sub Autoshedule_Click()
Dim students As DAO.Recordset
Dim appointment As DAO.Recordset
Dim StudApps As DAO.Recordset
Dim TeacApps As DAO.Recordset
Dim StudentId As String
Dim teacherID As String
Dim sql As Variant
Dim Score As Long
Dim isfirst As Boolean
Dim i, c As Long
Dim Time As Double
Dim t1 As Long
Dim t2 As Long
Dim time1, time2 As Variant

'do demand fill
Call whoisindemand

sql = "SELECT txStudsForPEve.StudentID, txStudsForPEve.ReciveDate FROM txStudsForPEve ORDER BY txStudsForPEve.demand ,txStudsForPEve.ReciveDate"
Set students = DBEngine(0)(0).OpenRecordset(sql)
c = 1
isfirst = True
While Not students.EOF
StudentId = students.Fields("StudentID")
If StudentId = "1609" Then
StudentId = StudentId
End If
Me.Autoshedule.Caption = Str(c)
c = c + 1
DoEvents
'find all appointments requested by student
sql = "SELECT txAppointments.ID, txAppointments.StudentID, txAppointments.subject, txAppointments.Requested, txAppointments.Priority, txAppointments.Unacceptable, txAppointments.Set, txAppointments.Time, txAppointments.Demand FROM txAppointments WHERE (((txAppointments.StudentID)='" & StudentId & "') AND ((txAppointments.Requested)=True) AND ((txAppointments.Unacceptable)=False)) ORDER BY txAppointments.Demand;"
Set appointment = DBEngine(0)(0).OpenRecordset(sql)
While Not appointment.EOF
subject = appointment.Fields("subject")
sql = "SELECT txPapps.ID, txPapps.StudentID, txPapps.Available, txPapps.Time, txPapps.Score, txPapps.Link FROM txPapps WHERE (((txPapps.StudentID)='" & StudentId & "') AND ((txPapps.Available)=True)) ORDER BY txPapps.Time;"
Set StudApps = DBEngine(0)(0).OpenRecordset(sql)
t1 = StudApps.AbsolutePosition
If t1 <> -1 Then
StudApps.MoveLast
t2 = StudApps.AbsolutePosition
StudApps.MoveFirst
End If
While Not StudApps.EOF
sql = "SELECT txTapps.ID, txTapps.subject, txTapps.Available, txTapps.Time, txTapps.score, txTapps.Link FROM txTapps WHERE (((txTapps.subject)= '" & subject & "') AND ((txTapps.Available) = True)) ORDER BY txTapps.Time;"
Set TeacApps = DBEngine(0)(0).OpenRecordset(sql)
While Not TeacApps.EOF

time1 = DateDiff("s", TeacApps.Fields("time"), StudApps.Fields("time"))
If time1 = 0 Then
StudApps.Edit
StudApps.Fields("Available") = False
StudApps.Fields("Link") = appointment.Fields("ID")
StudApps.Update


TeacApps.Edit
TeacApps.Fields("Available") = False
TeacApps.Fields("Link") = appointment.Fields("ID")
TeacApps.Update 'move to the next teacher

appointment.Edit
appointment.Fields("set") = True
appointment.Fields("time") = StudApps.Fields("time")
appointment.Update

TeacApps.MoveLast
StudApps.MoveLast
End If
TeacApps.MoveNext
Wend
StudApps.MoveNext
Wend
appointment.MoveNext
Wend
students.MoveNext
Wend
Me.Autoshedule.Caption = "AutoShed"
'select a student
'score his remaining appointments
'generate a list pf remaining teachers
'pick a teacher that fits his next best score
'continue
End Sub
[/vbcode]
[vbcode]
'=================================================================================================== ====
'this sets up tokens for setting appointment, it bases itself on the studs and teachers table
'so set you limitations in this instance
Private Sub BuildApps_Click()
Dim source As DAO.Recordset
Dim dest As DAO.Recordset
Dim t1 As Double
Dim t2 As Double
Dim stuID As String
Dim onemin As Double
Dim debug1 As Variant
Dim debug2 As Variant
Dim i As Double

onemin = 20 / (24 * 60)


Set dest = DBEngine(0)(0).OpenRecordset("txPapps")
Set source = DBEngine(0)(0).OpenRecordset("txStudsForPEve")

DoCmd.SetWarnings False
Call DoCmd.RunSQL("DELETE * from txPapps")
DoCmd.SetWarnings True

While Not source.EOF
stuID = source.Fields("StudentID")
t1 = source.Fields("StartTime")
t2 = source.Fields("EndTime")
For i = t1 To t2 Step onemin
dest.AddNew
dest.Fields("StudentID") = stuID
dest.Fields("Time") = i
dest.Update
Next i
source.MoveNext
Wend


Set dest = DBEngine(0)(0).OpenRecordset("txTapps")
Set source = DBEngine(0)(0).OpenRecordset("txTeaForPEve")

DoCmd.SetWarnings False
Call DoCmd.RunSQL("DELETE * from txTapps")
DoCmd.SetWarnings True

While Not source.EOF
stuID = source.Fields("Subject")
t1 = source.Fields("StartTime")
t2 = source.Fields("EndTime")
For i = t1 To t2 Step onemin
dest.AddNew
dest.Fields("Subject") = stuID
dest.Fields("Time") = i
dest.Update
Next i
source.MoveNext
Wend
End Sub
[/vbcode]
[vbcode]
'=================================================================================================== ========
'waps out all the appointmnts
Private Sub ClearAll_Click()
Dim ToClear As DAO.Recordset

Set ToClear = DBEngine(0)(0).OpenRecordset("txPapps")
While Not ToClear.EOF
ToClear.Edit
ToClear.Fields("Link") = Null
ToClear.Fields("Available") = True
ToClear.Fields("Score") = 0
ToClear.Update
ToClear.MoveNext
Wend

Set ToClear = DBEngine(0)(0).OpenRecordset("txTapps")
While Not ToClear.EOF
ToClear.Edit
ToClear.Fields("Link") = Null
ToClear.Fields("Available") = True
ToClear.Update
ToClear.MoveNext
Wend

Set ToClear = DBEngine(0)(0).OpenRecordset("txAppointments")
While Not ToClear.EOF
ToClear.Edit
ToClear.Fields("Time") = Null
ToClear.Fields("Set") = False
ToClear.Update
ToClear.MoveNext
Wend

End Sub

[/vbcode]

0
Comment
Question by:Dubs
2 Comments
 
LVL 29

Accepted Solution

by:
leonstryker earned 25 total points
ID: 17930654
Dubs,

You are asking for someone to rewrite this application for you.  This not the way EE works. We are here to answer technical questions and to help you in writting code.

Leon
0
 

Author Comment

by:Dubs
ID: 17930715
Yeah, ive looked at the code and realised that there isn't any easy way to insert a line of code to do this.

i though originally it may have been a case of introducing a new variable but realise it's more in depth than that.

ill get the q closed off.

cheers

greg
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now