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:

  1. Go to my home computer, remote into my work computer, and check my calendar
  2. 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'>&quot;
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'>&#xf017;</i></td><td>content</td></tr>"
LocnRow = "<tr>" & Style & "<i class='fas'>&#xf3c5;</i></td><td>content</td></tr>"
AttsRow = "<tr>" & Style & "<i class='far'>&#xf2bd;</i></td><td>content</td></tr>"
DescRow = "<tr>" & Style & "<i class='fas'>&#xf039;</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

  1. In your work computer’s Outlook, press Alt+F11 to open the VBA Editor window
  2. In the left pane, navigate to Project1 > Microsoft Outlook Objects > ThisOutlookSession
  3. 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.
  4. Change the 2 instances of <address@domain.com> to your email address
  5. 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!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s