[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now


vb timetable scheduling

Posted on 2006-11-13
Medium Priority
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?


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
'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
t2 = StudApps.AbsolutePosition
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.Fields("Available") = False
StudApps.Fields("Link") = appointment.Fields("ID")

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

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

End If
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
End Sub
'=================================================================================================== ====
'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.Fields("StudentID") = stuID
dest.Fields("Time") = i
Next i

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.Fields("Subject") = stuID
dest.Fields("Time") = i
Next i
End Sub
'=================================================================================================== ========
'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.Fields("Link") = Null
ToClear.Fields("Available") = True
ToClear.Fields("Score") = 0

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

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

End Sub


Question by:Dubs
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 29

Accepted Solution

leonstryker earned 50 total points
ID: 17930654

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.


Author Comment

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.



Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

656 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