How To Email Yourself Tomorrow’s Schedule

Occasionally, when I’m not at work, I find myself wanting to know what tomorrow’s schedule looks like. Since my employer has disabled calendar syncing, I’m usually faced with two options:

Go to my home computer, remote into my work computer, and check my calendar
Decide it’s too much work and give up

Of course I could go with the first option. I know I could. You know I could. But we both know what option I go with – every time. So I’m left there on the couch, staring at my computer across the room, thinking “I can do this… but it’s all the way over there…”

It was that inherent laziness that drove me to spend hours working tirelessly on a way to see my agenda without ever leaving the couch. Now, all I have to do is send a specific email from my phone to my work computer, and it will email me back a nicely formatted list of all the meetings I have for that day. Problem solved!

“Laziness is the mother of invention.”
– Me

The Code

It might look scarier than my last post, but the below code really isn’t that bad, and it’s actually easier to implement. The only reason it’s even this large is that I wanted to format the email with a pretty HTML table. Without that, it would only be about 20 lines long.

So, here it is. I’ll tell you how to set it up below.

	Option Compare Text

	Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
	Dim Items() As String
	Dim Item As Object
	Dim Appts As Object
	Dim Appt As Object
	Dim Time1 As String
	Dim Time2 As String
	Dim IconLink As String
	Dim CSS As String
	Dim HTML As String
	Dim Style As String
	Dim HeadRow As String
	Dim TimeRow As String
	Dim LocnRow As String
	Dim AttsRow As String
	Dim DescRow As String
	Dim Title As String
	Dim Time As String
	Dim LName As String
	Dim FName As String
	Dim Attendees As String
	Dim Desc As String
	Dim Start As Integer
	Dim Finish As Integer

	' Loop through emails just received ————————————————————-
	Items = Split(EntryIDCollection, ",")
	For i = 0 To UBound(Items)
	Set Item = Application.Session.GetItemFromID(Items(i))
	If TypeOf Item Is OutLook.MailItem Then

	If Item.SenderEmailAddress = "<address@domain.com>" _
	And Item.Subject Like "agenda" Or Item.Subject Like "schedule" Then

	Set Appts = Application.Session.GetDefaultFolder(olFolderCalendar).Items
	Appts.IncludeRecurrences = True
	Appts.Sort "[Start]"

	' Recognize days of the week up to a week from today
	If Item.Subject Like "Today" Then Offset = 0
	If Item.Subject Like "Tomor" Then Offset = 1
	If Item.Subject Like "Monda" Then Offset = ((8 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Tuesd" Then Offset = ((9 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Wedne" Then Offset = ((10 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Thurs" Then Offset = ((11 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Frida" Then Offset = ((12 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Satur" Then Offset = ((13 – Weekday(Now)) Mod 7) + 1
	If Item.Subject Like "Sunda" Then Offset = ((14 – Weekday(Now)) Mod 7) + 1

	' Restrict Appointments to that day
	Time1 = "'" & Format(DateAdd("d", Offset, Date), "m/d/yy hh:mm AMPM") & "'"
	Time2 = "'" & Format(DateAdd("d", Offset + 1, Date), "m/d/yy hh:mm AMPM") & "'"
	Set Appts = Appts.Restrict("[Start] > " & Time1 & " AND [End] < " & Time2)

	If Appts(1) Is Nothing Then
	HTML = "No meetings on " & Format(DateAdd("d", Offset, Date), "MMM d") & "!"
	Else
	' Setup HTML ————————————————————————
	IconLink = "<link rel='stylesheet' " & _
	"href='https://use.fontawesome.com/releases/v5.7.0/css/all.css'>"
	CSS = "<style type='text/css'>" & _
	"td {vertical-align:top; padding:5px 0px 0px 0px;}</style>"
	HTML = "<head>" & IconLink & CSS & "</head>" & _
	"<body style='font-family:Verdana; color:#606060;'>"

	' Fill HTML table with appointment info
	Style = "<td style='padding:5px 3px 0px 3px; text-align:center; width:20px;'>"

	HeadRow = "<tr><td colspan='2' style='font-weight:bold; padding-top:0px;'>" & _
	"content</td></tr>"
	TimeRow = "<tr>" & Style & "<i class='far'></i></td><td>content</td></tr>"
	LocnRow = "<tr>" & Style & "<i class='fas'></i></td><td>content</td></tr>"
	AttsRow = "<tr>" & Style & "<i class='far'></i></td><td>content</td></tr>"
	DescRow = "<tr>" & Style & "<i class='fas'></i></td><td>content</td></tr>"

	For Each Appt In Appts
	Title = Trim(Replace(Appt.Subject, "FW: ", ""))

	Time = Format(Appt.Start, "MMM d, h:mm AM") & " – " & Format(Appt.End, "h:mm AM")
	Time = Replace(Replace(Time, " AM", ""), " PM", "")

	' Get list of attendees
	Attendees = ""
	For r = 1 To Appt.Recipients.Count
	LName = Left(Appt.Recipients(r), InStr(Appt.Recipients(r), ","))
	FName = Mid(Appt.Recipients(r), InStr(Appt.Recipients(r), ",") + 1, 100)

	Attendees = Attendees & FName & " " & LName
	Next
	Attendees = Left(Attendees, Len(Attendees) – 1)

	' Clean up the description
	Desc = Appt.Body
	Do While InStr(Desc, "—–Orig") > 0
	Start = InStr(Desc, "—–Orig")
	Finish = InStr(Start, Desc, "WHERE")
	MsgBox Finish
	Finish = InStr(Finish, Desc, vbCrLf)
	Desc = Trim(Left(Desc, Start – 1) & Mid(Desc, Finish, 1000))
	Loop
	If Desc = "" Then Desc = "No Description"

	' Assemble the table
	HTML = HTML & "<table style='font-size:9pt; border-left:solid 5px #77ccff; " & _
	"padding:0px 0px 5px 5px; margin-bottom:20px;'>"
	HTML = HTML & Replace(HeadRow, "content", Title)
	HTML = HTML & Replace(TimeRow, "content", Time)
	HTML = HTML & Replace(LocnRow, "content", Appt.Location)
	HTML = HTML & Replace(AttsRow, "content", Attendees)
	HTML = HTML & Replace(DescRow, "content", Desc)
	HTML = HTML & "</table>"
	Next
	HTML = HTML & "</body></html>"

	Set Appt = Nothing
	End If

	' Send out the agenda summary email —————————————————-
	Set Mail = OutLook.Application.CreateItem(olMailItem)
	With Mail
	.To = "<address@domain.com>"
	.Subject = "Agenda for " & Format(DateAdd("d", Offset, Date), "ddd, MMM d")
	.HTMLBody = HTML
	.Send
	End With

	Item.UnRead = False
	Item.Move GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
	End If
	End If
	Next

	Set Item = Nothing
	End Sub

view raw SendAgenda.txt hosted with ❤ by GitHub

Setting Up the Code

In your work computer’s Outlook, press Alt+F11 to open the VBA Editor window
In the left pane, navigate to Project1 > Microsoft Outlook Objects > ThisOutlookSession
Copy/paste the above code into ThisOutlookSession
1. If you happen to already have a sub named Application_NewMailEx in there, you’ll have to do some editing, because the name is important, and you can’t have duplicate subs. If you’re not sure what to do, just leave a comment and I’ll help as much as I can.
Change the 2 instances of <address@domain.com> to your email address
Done!

Using the Code

Now here’s the easy part. All you have to do is email your work address from the address you just added to the code. If you use the word “agenda” or “schedule” in the subject line, along with a day of the week, you should get an email back with a nicely formatted table listing all your meetings for that day. Here are some example subject lines that would all give you exactly what you’d expect:

Today’s Schedule
tomorrow’s agenda
agenda Friday

Right now, it only accepts day names up to a week from today. I could have made it accept actual dates as well, but I was too lazy.

Anyway, I hope you like it. And, as always, if you have any questions or comments, feel free to post them below!

How To Email Yourself Tomorrow’s Schedule

The Code

Setting Up the Code

Using the Code

Published by David J. David

Leave a Reply Cancel reply

The Code

Setting Up the Code

Using the Code

Share this:

Like this:

Published by David J. David

Leave a Reply Cancel reply