You’ve created a database for scheduling appointments, one little problem when entering these appointments you can’t tell if it clashes with another appointment (especially, if you are not the only one entering). You could use a query but I always thought this would be handled better in a Module besides, I had an old database from 2002 (sorry, site no longer up so I can’t post a link) that was already part of the way there. So, this looked like a good time to *make it work*! Let’s get started…
My parameters:
(In this example I am using the below table, you will need to change the names here and in the Module to match yours.)
tblActivities
aActivityID (PK, Autonumber)
aAssociateID (FK related to tblAssociateProfile, Number, Long Integer)
aDate (Date/Time, Short Date [ No need to use Input Mask at Table Level ])
aStartTime (Date/Time, Medium Time [ Input Mask: 99:00\ >LL;0;_ ])
aEndTime (Date/Time, Medium Time [ Input Mask: 99:00\ >LL;0;_ ])
etc…
Module (Named: modCollisionCheck)…
You can incorporate into an already existing Module but for ease you can copy/paste the below into a new Module.
Option Compare Database Option Explicit Public pubActivityID As Long Public Function getActivityID() getActivityID = pubActivityID End Function Function fCollisionCheck(dteDate As Date, stStartTime As Date, etEndTime As Date, lngAssociateID As Long) '7.11.2016 rtw modified 'https://www.access-diva.com/blog/p=397 Dim dbDuration As Double Dim se As Date 'Starting time of appointments already made (in table) Dim ee As Date 'Ending time of appointments already made (in table) Dim blCollision As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset Dim frm As Form Set frm = Screen.ActiveForm Set db = CurrentDb Set rs = db.OpenRecordset("tblActivities", dbOpenDynaset) blCollision = False frm.lblCollisionCheck.Caption = " " dbDuration = etEndTime - stStartTime With rs Do Until rs.EOF 'First check if the appointment date on the form is the same as the record in the table. 'The recordset could be filtered at this point thus avoiding 'to have to loop through all the records in the Appointment table. If !aDate = dteDate And !aAssociateID = lngAssociateID Then se = !aStartTime ee = !aStartTime + dbDuration 'Lembit Soobik's nifty formula for checking collisions If stStartTime < ee And etEndTime > se And pubActivityID <> !aActivityID Then blCollision = True frm.lblCollisionCheck.Caption = "Collision" 'MsgBox "Collision with Appointment ID: " & !aActivityID & vbCrLf _ & "Starting at: " & se & vbCrLf _ & "Ending at: " & ee, vbExclamation, "Collision Check" End If End If .MoveNext Loop rs.Close Set rs = Nothing End With db.Close Set db = Nothing If Not blCollision Then frm.lblCollisionCheck.Caption = " " 'MsgBox "No collisions encountered", vbInformation, "You made it" End If End Function
Form…
Place Label, lblCollisionCheck, on your Form, in this example it’s above the Command Buttons. You will need to place one on your Form use that potion of the code. However, if you like you can comment out those lines and use the lines below that are pop-up messages. (I personally like the Label as no extra clicking required by the End User.)
To use the Module above the Form must be set to Pop-Up = No. If you want the Form to be a Pop-Up in the Module above you must change this…
Set frm = Screen.ActiveForm
to
Set frm = Forms![YOUR FORM NAME]
Side Note: If you want to use a Main Form\Subform set up then the lblCollisionCheck must be on the Main Form, all other Controls can be on the Subform. Since we are reading the Recordsource of the Subform no need to *worry about* the other Controls.
In the After_Update event of txtStartTime place (note the name of the Controls):
If Not IsNull(Me.txtEndTime) Then Call fCollisionCheck(Me.txtDate, Me.txtStartTime, Me.txtEndTime, Me.cboAssociateID) End If
In the After_Update event of txtEndTime place (note the name of the Controls):
pubActivityID = Me.txtActivityID Call fCollisionCheck(Me.txtDate, Me.txtStartTime, Me.txtEndTime, Me.cboAssociateID)
In the Lost_Focus event of both the txtStartTime and txtEndTime place (I like the extra Save.):
DoCmd.RunCommand acCmdSaveRecord
In the Forms On_Close event (We want to remember to drop the Public Variable when closing the Form in case we want to use it elsewhere.):
pubActivityID = Empty
So, if you enter an appointment that conflicts with another one (See the message?)…
Now, just change the time and message, Collision, will go away provided there still isn’t one!
Recent Comments
No comments.