Graham Mayor
... helping to ease the lives of Microsoft Word users.
 |
 |
 |
Many people access the material from this web site daily. Most just take what they want and run. That's OK, provided they are not selling on the material as their own; however if your productivity gains from the material you have used, a donation from the money you have saved would help to ensure the continued availability of this resource. Click the appropriate button above to access PayPal.
Recurring Outlook appointments that skip weekends
Outlook has the ability to provide appointments etc. that recur at a variety of selectable intervals, but the one type of interval it cannot manage is to move an appointment or meeting to a weekday when the scheduled appointment falls at a weekend. This page aims to address that.
The solution arose from a user whose organisation wished to schedule meetings twice a month on the 15th of the month and the last day of the month, but when either date fell at a weekend, the meeting would take place on the previous workday, which Outlook cannot handle.
On thinking over the problem, I felt it could be handled by reference to an Excel worksheet to calculate and store both the valid dates and the whether the meetings had been created for the current month.
The worksheet uses the function:
=WORKDAY(DATE(YEAR(A2),MONTH(A2),16),-1)
in Cell B2, and
=WORKDAY(DATE(YEAR(A2),MONTH(A2)+1,1),-1)
in Cell C2 to calculate the required workdays.
Column D begins with all the entries as
FALSE
Save the workbook and note the name and path (you can download a suitable workbook by clicking this link.)
The following code goes in the ThisOutlookSession module of the Outlook VBA project:
The format of the macro code when pasted from the panels to the VBA editor , is all aligned left. For ease of re-alignment to provide the original spacing, you could consider Smart Indenter, which works with all Office versions to date and can be obtained from - https://www.oaltd.co.uk/Indenter/Default.htm
Private Sub Application_Startup()
Const strWorkBook As String = "C:\Path\Meetings.xlsx" 'The workbook with the dates
Const strSheet As String = "Sheet1"
Dim objNS As Outlook.NameSpace
Dim strDate As String
Dim strDate1 As String
Dim strDate2 As String
Dim Arr() As Variant
Dim iCols As Long
Dim iRows As Long
Set objNS = GetNamespace("MAPI")
strDate = "01" & Format(Date, "/MM/YYYY")
Arr = xlFillArray(strWorkBook, strSheet)
For iRows = 0 To UBound(Arr, 2)
If CDate(strDate) = Arr(0, iRows) Then
If Arr(3, iRows) = True Then
MsgBox "No meeting update required"
GoTo lbl_Exit
Else
strDate1 = Arr(1, iRows)
strDate2 = Arr(2, iRows)
Call NewMeeting(CDate(strDate1), CDate(strDate2))
'Field names in the following line are from the example workbook
Call UpdateLog(strWorkBook, strSheet, "Month", "Processed", strDate, "TRUE")
End If
End If
Next iRows
lbl_Exit:
Exit Sub
End Sub
Private Function xlFillArray(strWorkBook As String, _
strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long
strWorksheetName = strWorksheetName & "$]"
Set CN = CreateObject("ADODB.Connection")
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkBook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1
With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function
The above code runs every time Outlook is started and quickly checks the first day of the current month against the first column of the worksheet. The macro uses an ADO function to read the worksheet into an array, which is almost instantaneous, even with many years of data. (The example worksheet has dates to December 2025). The array in memory is then checked for the row which relates to the first day of the current month.
If the first day of the month is located, the function reads the last column labelled 'Processed' on the example (though the column names are immaterial). If the value for the current row and last column is TRUE, the macro ends. If however the value is FALSE the, macro collects the two dates in columns B and C and assigns them to variables.
Using the stored variables, the macro then calls a process 'NewMeeting' to create the meetings for the current month, and finally another process 'UpdateLog' to change the last column entry in the worksheet from FALSE to TRUE.
The code for the two called macros goes in a new standard module. Click Insert > Module from the VBA editor menu bar.
Public Sub NewMeeting(Date1 As Date, Date2 As Date)
Dim olMeeting1 As Object, olMeeting2 As Object
Dim olRequiredAttendee As Recipient
Dim olOptionalAttendee As Recipient
Dim olResourceAttendee As Recipient
Dim StartTime As Date
Dim lngDuration As Long
Dim strLocation As String
Dim strSubject As String
Set olMeeting1 = Application.CreateItem(olAppointmentItem)
StartTime = "09:00"
lngDuration = 90 'minutes
strLocation = "Conference Room"
strSubject = "Strategy Meeting"
With olMeeting1
.MeetingStatus = olMeeting
.Subject = strSubject
.Location = strLocation
.Start = Date1 & Chr(32) & StartTime
.Duration = lngDuration
'Required attendees
Set olRequiredAttendee = .Recipients.Add("Graham Mayor")
olRequiredAttendee.Type = olRequired
Set olRequiredAttendee = .Recipients.Add("Bill Bloggs")
olRequiredAttendee.Type = olRequired
'Optional attendees
'Set olOptionalAttendee = .Recipients.Add("John Smith")
'olOptionalAttendee.Type = olOptional
'Resource attendees
'Set olResourceAttendee = .Recipients.Add("Fred Jones")
'olResourceAttendee.Type = olResource
.Display
'.sEnd 'restore after testing
End With
Set olMeeting2 = Application.CreateItem(olAppointmentItem)
strLocation = "Boardroom"
StartTime = "13:00"
lngDuration = 120 'minutes
strSubject = "Month End Meeting"
With olMeeting2
.MeetingStatus = olMeeting
.Subject = strSubject
.Location = strLocation
.Start = Date2 & Chr(32) & StartTime
.Duration = lngDuration
'Required attendees
Set olRequiredAttendee = .Recipients.Add("Graham Mayor")
olRequiredAttendee.Type = olRequired
Set olRequiredAttendee = .Recipients.Add("Bill Bloggs")
olRequiredAttendee.Type = olRequired
'Optional attendees
'Set olOptionalAttendee = .Recipients.Add("John Smith")
'olOptionalAttendee.Type = olOptional
'Resource attendees
'Set olResourceAttendee = .Recipients.Add("Fred Jones")
'olResourceAttendee.Type = olResource
.Display
'.sEnd 'Restore after testing
End With
lbl_Exit:
MsgBox "Meetings created"
Exit Sub
End Sub
Public Sub UpdateLog(strWorkBook As String, _
strWorksheetName As String, _
Field1 As String, _
Field2 As String, _
strFromData As String, _
strToData As String)
Dim RS As Object
Dim CN As Object
Dim bUpdated As Boolean
strWorksheetName = strWorksheetName & "$]"
Set CN = CreateObject("ADODB.Connection")
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkBook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Set RS = CreateObject("ADODB.Recordset")
With RS
.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 2
.MoveFirst
Do While Not .EOF
If .Fields(Field1) = strFromData Then
.Fields(Field2) = strToData
.Update
bUpdated = True
End If
.MoveNext
Loop
End With
If bUpdated Then MsgBox "Log updated"
lbl_Exit:
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
Exit Sub
End Sub
Sub ResetLog()
'Reset all the Log values to False for the purpose of testing
Const strWorkBook As String = "C:\Path\Meetings.xlsx" 'The workbook to be processed
Const strSheet As String = "Sheet1" 'The worksheet that represents the log
UpdateLog strWorkBook, strSheet, "Processed", "Processed", True, False
lbl_Exit:
Exit Sub
End Sub
The macros contain several message boxes that are provided for testing the macro. I have including a macro to reset the worksheet for use while testing and I have temporarily commented out the commands to send the invitations to the attendees again for use while testing.
You can add as many attendees as you wish, and you can change the meeting locations, subjects, durations, times independently.
If you want to change the dates, you will need to do that in the worksheet.
So there you have it. The first time in any given month that Excel is started, the configured meetings for that month will be added.
It should not be too difficult to adapt this approach for other repeating functions.
Recurring Appointments
I tend to haunt VBA programming web site looking for inspiration, and helping out with solutions to problems. These are usually Word problems, but occasionally I delve into Excel and Outlook.
The solution posted here is the result of a query posted by a user to overcome some limitations in the recurrence of Outlook items - in this case Meetings.