Generate Outlook Daily Journal template

outlookJournal.vb

Option Explicit

Function GetFormattedCurrentDateString()
    GetFormattedCurrentDateString = Format(Now(), "mm/dd/yyyy")
End Function

Function GetFormattedDateString(dateToFormat As Date)
    GetFormattedDateString = Format(dateToFormat, "mm/dd/yyyy")
End Function

Function GetCurrentMonthName()
    GetCurrentMonthName = MonthName(Month(Now()), False)
End Function

Function GetFirstDayOfWeek()
    GetFirstDayOfWeek = Now() - Weekday(Now(), vbUseSystem) + 1
End Function

Function GetLastDayOfWeek()
    GetLastDayOfWeek = Now() - Weekday(Now(), vbUseSystem) + 7
End Function

Function ReplaceInTemplate(ByVal template As Outlook.MailItem, ByVal textToReplace As String, replacementText As String)
    template.HTMLBody = Replace(template.HTMLBody, textToReplace, replacementText)
    template.Subject = Replace(template.Subject, textToReplace, replacementText)
    Set ReplaceInTemplate = template
End Function

Function ReplaceToday(ByVal template As Outlook.MailItem)
    Dim toReplace As String: toReplace = "{today}"
    Dim replacementText As String: replacementText = GetFormattedCurrentDateString()
    Set ReplaceToday = ReplaceInTemplate(template, toReplace, replacementText)
End Function

Function ReplaceMonth(ByRef template As Outlook.MailItem)
    Dim currentMonthName As String: currentMonthName = GetCurrentMonthName()
    Dim toReplace As String: toReplace = "{month}"
    Dim replacementText As String: replacementText = currentMonthName
    Set ReplaceMonth = ReplaceInTemplate(template, toReplace, replacementText)
End Function

Function ReplaceWeekRange(ByRef template As Outlook.MailItem)
    Dim toReplace As String: toReplace = "{week}"
    
    Dim replacementText As String: replacementText = GetFormattedDateString(GetFirstDayOfWeek()) & " - " & GetFormattedDateString(GetLastDayOfWeek())

    Set ReplaceWeekRange = ReplaceInTemplate(template, toReplace, replacementText)

End Function


Sub RunReplacers(template As Outlook.MailItem)
    
    Set template = ReplaceToday(template)
    Debug.Print ("Today Replace Complete")

    Set template = ReplaceMonth(template)
    Debug.Print ("WeekRange Replace Complete")

    Set template = ReplaceWeekRange(template)
    Debug.Print ("WeekRange Replace Complete")

End Sub

Sub GenerateJournalTemplate()
    On Error GoTo ErrHandler:
    
    Dim path As String: path = "C:\Users\username\AppData\Roaming\Microsoft\Templates\My Templates\DailyJournal.oft"
    Dim emailTemplate As Outlook.MailItem: Set emailTemplate = Application.CreateItemFromTemplate(path)
    
    RunReplacers emailTemplate
    emailTemplate.Display

Done:
    Set emailTemplate = Nothing
    Exit Sub
ErrHandler:
    Set emailTemplate = Nothing

    Dim message As String: message = "Error " & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description & " " & vbCrLf & "Source: " & Err.Source
    Debug.Print message
    MsgBox message
End Sub