A user wanted to create a macro that would send his upcoming appointments:

1. Each night at 9:00 pm, email me a snapshot of my calendar for the next day

2. Each Sunday at 9:00 pm, also email me a snapshot of my calendar for the upcoming week (Mon-Sun).

Do you want pretty or just functional? Outlook's Share > Email Calendar function creates a pretty calendar (it can be automated) or you can create a simple list in an email message. The simple list is not pretty (you can use HTMLBody and tags to pretty it up a little) but does the job. To run the macro automatically, you can use a reminder.

If you want to send the calendar in a message you are composing, you can use the Insert > Calendar command. This adds the pretty calendar and the ICS file to the email you are composing. The macro at Add the .ICS file to a message automates adding the ics file as an attachment.

Pretty Email Agenda

This macro creates a nicely formatted email message, as seen in the screenshot above. I used Free/Busy and Subject for the details. Full Details will include the short list as seen in the screenshot, with the full details below.

Because I'm sending this to myself, I'm removing the .ics file attachment that is normally added to the message.

Public Sub SendPrettyAgenda()
Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oCalendarSharing As CalendarSharing
Dim objMail As MailItem
Dim wd As Integer

Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
Set oCalendarSharing = oFolder.GetCalendarExporter

' get the day - send sat/sun/monday out Fri night
' Sun = 1, Mon = 2, Tue = 3, Wed = 4, Thu = 5, Fri = 6, Sat = 7
' none set Sat/Sun
wd = Weekday(Date)
If wd >= 2 And wd <= 7 Then
    lDays = Date + 1
ElseIf wd = 1 Then
    lDays = Date + 7
End If

With oCalendarSharing
' options are olFreeBusyAndSubject, olFullDetails, olFreeBusyOnly
    .CalendarDetail = olFreeBusyAndSubject
    .IncludeWholeCalendar = False
    .IncludeAttachments = False
    .IncludePrivateDetails = True
    .RestrictToWorkingHours = False
    .StartDate = Date + 1
    .EndDate = lDays
End With

' prepare as email
' options: olCalendarMailFormatEventList, olCalendarMailFormatDailySchedule
Set objMail = oCalendarSharing.ForwardAsICal(olCalendarMailFormatDailySchedule)
 
 ' Send the mail item to the specified recipient.
 With objMail
 .Recipients.Add "me@slipstick.com"

' Remove the attached ics
 .Attachments.Remove (1)
 .Display 'for testing, change to .send
 End With

Set oCalendarSharing = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing
End Sub

Simple List of Appointments

This macro borrows from the code sample at "How to print a list of recurring dates using VBA" to create a simple list of appointments.

I'm only using the Subject, start and end times in this sample, but you can add any appointment field.

Use HTMLBody and HTML tags to format the list a little better.

Sub CreateListofAppt()
   
   Dim CalFolder As Outlook.MAPIFolder
   Dim CalItems As Outlook.Items
   Dim ResItems As Outlook.Items
   Dim sFilter, strSubject, strAppt As String
   Dim iNumRestricted As Integer
   Dim itm, apptSnapshot As Object
   Dim tStart As Date, tEnd As Date, tFullWeek As Date
   Dim wd As Integer
  
   ' Use the default calendar folder
   Set CalFolder = Session.GetDefaultFolder(olFolderCalendar)
   Set CalItems = CalFolder.Items

   ' Sort all of the appointments based on the start time
   CalItems.Sort "[Start]"
   CalItems.IncludeRecurrences = True

   ' Set an end date
    tStart = Format(Date + 1, "Short Date")
    tEnd = Format(Date + 2, "Short Date")
    tFullWeek = Format(Date + 6, "Short Date")
 
    wd = Weekday(Date)
   ' Sun = 1, Mon = 2, Tues = 3, Wed = 4, Thu = 5, Fri = 6, Sat = 7
' get next day appt, do whole week on sunday
If wd >= 2 And wd <= 6 Then
   sFilter = "[Start] >= '" & tStart & "' AND [Start] <= '" & tEnd & "'"
ElseIf wd = 1 Then
   sFilter = "[Start] >= '" & tStart & "' AND [Start] <= '" & tFullWeek & "'"
End If

Debug.Print sFilter
   Set ResItems = CalItems.Restrict(sFilter)

   iNumRestricted = 0

   'Loop through the items in the collection.
   For Each itm In ResItems
   Debug.Print ResItems.Count
      iNumRestricted = iNumRestricted + 1
      
 ' Create list of appointments
  strAppt = strAppt & vbCrLf & itm.Subject & vbTab & " >> " & vbTab & itm.Start & vbTab & " to: " & vbTab & Format(itm.End, "h:mm AM/PM")

   Next
   
' After the last occurrence is checked
' Open a new email message form and insert the list of dates
  Set apptSnapshot = Application.CreateItem(olMailItem)
  With apptSnapshot
    .Body = strAppt & vbCrLf & "Total appointments; " & iNumRestricted
    .To = "me@slipstick.com"
    .Subject = "Appointments for " & tStart
    .Display 'or .send
  End With

   Set itm = Nothing
   Set apptSnapshot = Nothing
   Set ResItems = Nothing
   Set CalItems = Nothing
   Set CalFolder = Nothing
   
End Sub

Use Reminders to trigger the macro

To schedule the macro, you can use a reminder to trigger the macro. For more information on this method, see "Send an Email When a Reminder Fires".

This macro needs to go in ThisOutlookSession; either macro above can go into a new module.

Private Sub Application_Reminder(ByVal Item As Object)
'IPM.TaskItem to watch for Task Reminders
If Item.MessageClass <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Send Message" Then
  Exit Sub
End If

' call the macro:
SendPrettyAgenda

' or
' CreateListofAppt

End Sub

Add the .ICS file to a message

This version of the macro will add the ics file to a message you are already composing. It automates using the Insert > Calendar button but will not add the "pretty" formatted list to the message, only adds the ICS file as an attachment.

As written, the calendar is three business days, starting "tomorrow". It shows only free/busy state and only working hours.

To use, add the macro to a button on your ribbon and run it when you need to add your availability to a message.

Public Sub AvailabilityICS()
Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oCalendarSharing As CalendarSharing
Dim objMail As MailItem ' As Inspector
Dim wd As Integer
Dim lDate As Date
Dim sDtate As Date

Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
Set oCalendarSharing = oFolder.GetCalendarExporter

' start date tomorrow
sDtate = Date + 1

' end date is 3 business days
' Sun = 1, Mon = 2, Tue = 3, Wed = 4, Thu = 5, Fri = 6, Sat = 7
wd = Weekday(Date)
If wd >= 1 And wd <= 3 Then
    lDate = sDtate + 2
ElseIf wd >= 4 Then
    lDate = sDtate + 4
End If

With oCalendarSharing
' options are olFreeBusyAndSubject, olFullDetails, olFreeBusyOnly
    .CalendarDetail = olFreeBusyOnly
    .IncludeWholeCalendar = False
    .IncludeAttachments = False
    .IncludePrivateDetails = False
    .RestrictToWorkingHours = True
    .StartDate = sDtate
    .EndDate = lDate
End With

SaveAsPath = "D:\Availability from " & Format(sDtate, "mmm dd - ") & Format(lDate, "mmm dd yyyy") & ".ics"
oCalendarSharing.SaveAsICal SaveAsPath

Set objMail = Application.ActiveInspector.CurrentItem
 
 ' Send the mail item to the specified recipient.
 With objMail
  .Attachments.Add SaveAsPath
  .Display
 End With

Set oCalendarSharing = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing
End Sub

How to use the macros on this page

First: You need to have macro security set to low during testing. The macros will not work otherwise.

To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor