How to Auto Send Your Weekly Schedule to Someone Else via an Outlook Email

If you always need to send your weekly schedule in your Outlook to someone else, such as your assistance, you can utilize the method shared in this article. It will use VBA to make it automatic with utmost ease.

For some reasons, some users look forward to letting their Outlook automatically send daily, weekly or monthly schedule to someone else at specific time. Though it is not supported by Outlook default features, you still can achieve it by the means introduced in the followings. Now read on to get the detailed steps.

Auto Send Your Weekly Schedule to Someone Else

1. At the very beginning, launch your Outlook application.
2. Then in the main Outlook screen, press “Alt + F11” keys to access VBA editor.
3. Subsequently, you need to find and open the “ThisOutlookSession” project.
4. Next copy the following VBA code into this project window.

Public objMail As Outlook.MailItem
Public dLastDayinThisWeek As Date
Public strWeeklySchedule As String

Private Sub Application_Reminder(ByVal Item As Object)
    If TypeOf Item Is TaskItem And Item.Subject = "Send Weekly Schedule" Then
 
       'Only Send Weekly Schedule on Workdays
       Select Case Weekday(Date)
              Case 2
                   dLastDayinThisWeek = Format(Date + 6, "YYYY-MM-DD")
              Case 3
                   dLastDayinThisWeek = Format(Date + 5, "YYYY-MM-DD")
              Case 4
                   dLastDayinThisWeek = Format(Date + 4, "YYYY-MM-DD")
              Case 5
                   dLastDayinThisWeek = Format(Date + 3, "YYYY-MM-DD")
              Case 6
                   dLastDayinThisWeek = Format(Date + 2, "YYYY-MM-DD")
              Case Else
                   Item.MarkComplete
                   Exit Sub
       End Select
 
       Call SendWeeklySchedule
 
       Item.MarkComplete
    End If
End Sub

Private Sub SendWeeklySchedule()
    Dim objCalendarFolder As Outlook.Folder
 
    strWeeklySchedule = ""
    Set objMail = Outlook.Application.CreateItem(olMailItem)
 
    Set objCalendarFolder = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar)
    Call ProcessFolders(objCalendarFolder)
 
    'Send the Mail
    With objMail
         .Subject = "My Weekly Schedule"
         .To = "assistant@datanumen.com"
         .Body = "This is my schedule this week." & vbCrLf & vbCrLf & "--------------------------------------------------------------------------------------" & vbCrLf & strWeeklySchedule
         .Send
    End With
End Sub

Private Sub ProcessFolders(objCurrentFolder As Outlook.Folder)
    Dim strFilter As String
    Dim objThisWeekAppointments As Outlook.Items
    Dim objAppointment As Outlook.AppointmentItem
    Dim objFileSystem As Object
    Dim strICSFile As String
    Dim objCalendarExporter As Outlook.CalendarSharing
    Dim objSubfolder As Outlook.Folder
 
    If objCurrentFolder.DefaultItemType = olAppointmentItem Then
       strFilter = "[Start] <= " & Chr(34) & dLastDayinThisWeek & " 11:59 PM" & Chr(34) & " AND [End] > " & Chr(34) & Format(Date, "YYYY-MM-DD") & " 00:00 AM" & Chr(34)
       Set objThisWeekAppointments = objCurrentFolder.Items.Restrict(strFilter)
 
       If objThisWeekAppointments.count > 0 Then
          Set objCalendarExporter = objCurrentFolder.GetCalendarExporter
 
          Set objFileSystem = CreateObject("Scripting.FileSystemObject")
          strICSFile = objFileSystem.GetSpecialFolder(2).Path & "\Weekly Schedule on " & Format(Date, "YYYY-MM-DD") & ".ics"
 
          'Export Calendar This Week as iCalendar File
          With objCalendarExporter
               .IncludeWholeCalendar = False
               .StartDate = Date
               .EndDate = dLastDayinThisWeek
               .CalendarDetail = olFullDetails
               .IncludeAttachments = True
               .IncludePrivateDetails = False
               .RestrictToWorkingHours = False
               .SaveAsICal strICSFile
          End With
 
          'Attach the iCalendar File to the New Mail
          objMail.Attachments.Add strICSFile
 
          'Get a List of All Appointments This Week
          For Each objAppointment In objThisWeekAppointments
              strWeeklySchedule = objAppointment.Subject & ": " & Format(objAppointment.Start, "mm/dd hh:mm AMPM") & " ~ " & Format(objAppointment.End, "mm/dd hh:mm AMPM") & vbTab & vbTab & objAppointment.Location & vbCrLf & "--------------------------------------------------------------------------------------" & vbCrLf & strWeeklySchedule
          Next
        End If
    End If
 
    'Process All Subfolders recursively
    If objCurrentFolder.folders.count > 0 Then
       For Each objSubfolder In objCurrentFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

5. After that, you should sign this code.
6. Later exit the current “Microsoft Visual Basic for Applications” window.
7. Next, head to “Tasks” area and create a new recurring task by the following steps:

• Click on the “New Task” button in ribbon.
• In the Task window, enter “Send Weekly Schedule” in the subject line.
• Next mark the checkbox before the “Reminder” option and set it as per your desired time to send the weekly schedule.
• After that, click on the “Recurrence” button in the ribbon.
• Subsequently, a new dialog box will pop up, in which you need to set the “Weekly” > “Recur every 1 week(s) on” > “Monday” > “No end date”.
• Lastly click “OK” to activate the task recurrence.

8. Eventually you can save and close the new task.
9. From now on, every time when the task reminder pops up, Outlook will send your schedule of this week to the predefined recipient automatically.

Recur to a Reliable Tool in Case of PST Damage

Despite boasting of multiple functions, Outlook still cannot be free of errors and crashes. Thus, by default, it comes endowed with a built-in repair tool, Scanpst. However, in most situations, this tool cannot be helpful. Hence, it is necessary to prepare another more poweful external tool, like DataNumen Outlook Repair.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including recover mdf and outlook repair software products. For more information visit www.datanumen.com