Outlook VBA Startup Event Holiday Reminder

The below code will automatically check if there's a holiday today. What this code does is runs an Outlook Startup event as soon as Outlook is launched. This code opens up an Excel workbook which runs code to compare today's date versus two different columns to see if a day matches today. If today matches a day in columns D or E, then Outlook will notify you that it's a holiday. This program is useful because you can automatically accomplish a task just by opening Outlook in the morning without having to remember to do this task.

Before inserting the code into the module, open up the Project Explorer in Outlook and enable the below reference:

Now just double click This Outlook Session, click Application there and then click Startup event. There are multiple VBA outlook events such as "NewMail" which runs code when you receive a new email. Paste the code from Outlook code here.

Outlook Code:

Private Sub Application_Startup()

'Microsoft Excel 15.0 Object Library must be enabled in Tools/Reference by checking the box


Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet


Set appExcel = CreateObject("Excel.Application")

strSheet = "C:\Users\Nonaluuluu\Desktop\VBATutorialCode Lessons\" & _
Outlook and Excel\Holidays.xlsm"
appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)


wks.Activate
appExcel.Application.Visible = True


 wkb.Application.Run "Module1.Code1"



End Sub

Excel Code:

Sub Code1()

erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range("F1").Select
ActiveCell.FormulaR1C1 = "=today()"

Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],C6,1,FALSE)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & erow), Type:=xlFillDefault

Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],C6,1,FALSE)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & erow), Type:=xlFillDefault

Columns("D:E").Select
Selection.Copy
Columns("D:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
    :=False, Transpose:=False

 Selection.Replace What:="#N/A", Replacement:="No", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
'2019 Holiday Check
Dim counter As Double
counter = 2
Dim Holiday As String

Do Until counter > erow
Holiday = Range("A" & counter).Value
If Range("D" & counter).Value <> "No" Then
MsgBox (Holiday & " is a holiday today in 2019")
End If
counter = counter + 1
Loop

counter = 2
'2020 Holiday Check
Do Until counter > erow
Holiday = Range("A" & counter).Value
If Range("E" & counter).Value <> "No" Then
MsgBox (Holiday & " is a holiday today in 2020")
End If
counter = counter + 1
Loop

Columns("D:F").Select
Selection.ClearContents

Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Nonaluuluu\Desktop\VBATutorialCode Lessons\Outlook and Excel\Holidays.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True

MsgBox ("Holiday check complete")

End Sub

Here's a youtube video with more information about this process.