Dynamic Quote-of-the-day in Outlook signature

Outlook 2016 has the ability to run macros just before an email is sent. Here is a quick macro, that can be added to your Outlook, which will replace a text in your email message with a random quote from a file.

-- Outlook 2016 Quote-of-the-day macro
-- To allow running of the macro, reduce Macro security
--   File -> Options -> Trust Center -> Trust Center Settings -> Macro Settings
--
-- To add the script, enable "Developer" mode by customizing the "ribbon" to enable it.
--   Copy and paste the entire script (including these comments) - save and close.
--
-- Ensure Mail compose format is HTML
--   File -> Options -> Mail -> Compose Messages -> HTML
--
-- Create a signature with the following case-sensitive text to be replaced with Quotes
--   %Random_Line%
--
-- Make sure the directory where the "quotes.txt" file is present matches the path in "QuotesFile" below
--
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ' Validate that the item sent is an email.
    If Item.Class <> olMail Then Exit Sub

    Const SearchString = "%Random_Line%"
    Const QuotesFile = "C:\Users\Public\quotes.txt"

    If InStr(Item.Body, SearchString) Then
        If FileOrDirExists(QuotesFile) = False Then
            MsgBox ("Quotes file wasn't found! Canceling message")
            Cancel = True
        Else
            Dim lines() As String
            Dim numLines As Integer
            numLines = 0

            ' Open the file for reading
            Open QuotesFile For Input As #1

            ' Go over each line in the file and save it in the array + count it
            Do Until EOF(1)
                ReDim Preserve lines(numLines + 1)
                Line Input #1, lines(numLines)
                numLines = numLines + 1
            Loop

            Close #1

            ' Get the random line number
            Dim randLine As Integer
            randLine = Int(numLines * Rnd())

            ' Insert the random quote
            Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))
            Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)
        End If
    End If
End Sub

Function FileOrDirExists(PathName As String)
    Dim iTemp As Integer

    On Error Resume Next
    iTemp = GetAttr(PathName)

    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select

    On Error GoTo 0
End Function

The quotes.txt file is just a simple file, with one quote per line. A small example

A person who never made a mistake never tried anything new. - Albert Einstein
A truly rich man is one whose children run into his arms when his hands are empty. -Unknown
An unexamined life is not worth living. -Socrates
Ask and it will be given to you; search, and you will find; knock and the door will be opened for you. -Jesus
Believe you can and you're halfway there. -Theodore Roosevelt
Build your own dreams, or someone else will hire you to build theirs. -Farrah Gray
Certain things catch your eye, but pursue only those that capture the heart. - Ancient Indian Proverb
Challenges are what make life interesting and overcoming them is what makes life meaningful. -Joshua J. Marine

A Sample saved signature and the resulting signature to the email recipient would look like

John Doe
%Random_Line%

John Doe
An unexamined life is not worth living. -Socrates

.