Automatically check that you have SeeMyTutor
availabilities within Outlook
Here
are the instructions for automatically checking that you have forthcoming
SeeMyTutor
availabilities and displaying an alert if a minimum criterion is not met.
The
programme will also re-colour available appointments as green and bookings in
red:
1)
In Outlook (2007 or 2010), press ALT+F11 to open the visual basic editor
window.
2)
Double click on Project1 > Microsoft Office Outlook Objects >
ThisOutlookSession
3)
You should then copy and paste in all the code below (as shown above).
Private Sub Application_Quit()
Call availcheck
End Sub
Private Sub Application_Startup()
Call availcheck
End Sub
Private Function Quote(MyText)
Quote = Chr(34) & MyText & Chr(34)
End Function
Sub availcheck()
Dim daysinadvance
As Integer
Dim startdate
As Date
Dim CU As
Integer
Dim enddate As
Date
Dim olApp As
Outlook.Application
Dim olNS As
Outlook.NameSpace
Dim myCalItems
As Outlook.Items
Dim
ItemstoCheck As Outlook.Items
Dim ThisAppt As
Outlook.AppointmentItem
Dim MyItem As
Object
Dim
StringToCheck As String
Dim minslots As
Integer
daysinadvance =
7 'THIS
IS THE NUMBER OF DAYS IN ADVANCE THAT YOT WANT TO CHECK OVER
minslots =
2 'THIS IS THE MINIMUM NUMBER OF SEEMYTUTOR
SLOTS NEEDED TO TRIGGER AN ALERT
startdate =
Day(Now()) & "/" & Month(Now()) & "/" &
Year(Now())
enddate =
startdate + daysinadvance
On Error Resume
Next
Set olApp =
GetObject(, "Outlook.Application")
If Err.Number
<> 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is
Nothing Then GoTo 78
Set olNS =
olApp.GetNamespace("MAPI")
Set myCalItems
= olNS.GetDefaultFolder(olFolderCalendar).Items
With myCalItems
.Sort
"[Start]", False
.IncludeRecurrences = True
End With
StringToCheck =
"[Start] >= " & Quote(startdate & " 12:00 AM")
& " AND [End] <= " & Quote(enddate & " 11:59
PM")
Debug.Print
StringToCheck
Set
ItemstoCheck = myCalItems.Restrict(StringToCheck)
Debug.Print
ItemstoCheck.Count
For Each MyItem
In ItemstoCheck
If MyItem.Class
= olAppointment Then
Set ThisAppt =
MyItem
If
Left(ThisAppt.Subject, 16) = "Appointment with" Then
ThisAppt.Categories = "Red Category"
ThisAppt.Save
End If
If
ThisAppt.Subject = "See My Tutor availability" Then
ThisAppt.Categories = "Green Category"
ThisAppt.Save
GoTo 7
End If
GoTo 9
7 CU = CU + 1
End If
9 Next MyItem
90 If CU <=
minslots Then MsgBox "Number of SeeMyTutor availability slots over the
next " & daysinadvance & " days is " & CU &
".", vbInformation, ""
Set myCalItems
= Nothing
Set
ItemstoCheck = Nothing
Set olNS =
Nothing
Set olApp =
Nothing
Set rngStart =
Nothing
Set ThisAppt =
Nothing
78 End Sub
4) You will need to modify the lines of code
that I have highlighted in red:
·
daysinadvance is a whole number that controls how many
days in advance are checked for slots.
·
minslots is a whole number equal to the minimum number of
seemytutor slots over the checked period needed to trigger an alert
5)
Exit Outlook and click yes when prompted:
6)
Upon re-opening Outlook, you may need to click enable macros.
If no alert
is created and you have no SeeMyTutor slots then you may need to adjust your
security settings:
·
In Outlook 2007: Select Tools > Macro > Security
> Choose: Warnings for all Macros. Then, quit Outlook and, upon re-opening
Outlook, click “Enable macros”
·
In Outlook 2010: Select File > Options > Trust
Center > Trust Center Settings > Notifications for all macros. Then, quit
Outlook and, upon re-opening Outlook, click “Enable macros”
Any
problems, let me know.
Phil
|
|
Dr Philip Denton BSc PhD PGCE PGCert
SFHEA Lecturer in Physical Chemistry Faculty of Science |
