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
- At the very beginning, launch your Outlook application.
- Then in the main Outlook screen, press “Alt + F11” keys to access VBA editor.
- Subsequently, you need to find and open the “ThisOutlookSession” project.
- 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
- After that, you should sign this code.
- Later exit the current “Microsoft Visual Basic for Applications” window.
- 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.
- Eventually you can save and close the new task.
- 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
Leave a Reply