Adding Buttons to MS Outlook

• Open Microsoft Outlook
• Tools –> Macro –> Visual Basic Editor or just press <ALT> <F11>
• Double click on the “ThisOutlookSession” widget in the project window. A code window will open up.
• Paste the code below into the code window.

• Tools –> Customize
• Click on the “Commands” tab
• Select the “Macros” category
• Drag both macros onto the toolbar. Do NOT close the “Customize window
• Right Click on each button to Change the Name and Icon for the new buttons.

Sub SpryReplyAll()
    Dim olApp As Outlook.Application
    Dim oSel As Outlook.Selection
    Dim oMail As Outlook.mailItem
    Dim oReply As Outlook.mailItem
    Dim oPrp As Outlook.ItemProperty
    Dim bFieldExists As Boolean
 
    newtext = "I read your email on " & Date & vbCrLf
    newtext = newtext & "I understand that you want ...." & vbCrLf
    newtext = newtext & "I will promptly respond to your request by MM/DD/YYYY" & vbCrLf
 
    Set olApp = Outlook.Application
    Set oSel = olApp.ActiveExplorer.Selection
    If oSel.Count > 1 Then
        MsgBox "You selected more than one email message. Select only one email and try again."
        Exit Sub
    End If
    If oSel.Count < 1 Then
        MsgBox "You have not selected an email to autorespond to."
        Exit Sub
    End If
 
    Set oMail = oSel.Item(1)
    Set oReply = oMail.ReplyAll
    oReply.Subject = "Spry Methods --> " & oReply.Subject
    oReply.Body = newtext & oReply.Body
    oReply.Display
End Sub
 
Sub SpryReply()
    Dim olApp As Outlook.Application
    Dim oSel As Outlook.Selection
    Dim oMail As Outlook.mailItem
    Dim oReply As Outlook.mailItem
    Dim oPrp As Outlook.ItemProperty
    Dim bFieldExists As Boolean
 
    newtext = "I read your email on " & Date & vbCrLf
    newtext = newtext & "I understand that you want ...." & vbCrLf
    newtext = newtext & "I will promptly respond to your request by MM/DD/YYYY" & vbCrLf
 
    Set olApp = Outlook.Application
    Set oSel = olApp.ActiveExplorer.Selection
    If oSel.Count > 1 Then
        MsgBox "You selected more than one email message. Select only one email and try again."
        Exit Sub
    End If
    If oSel.Count < 1 Then
        MsgBox "You have not selected an email to autorespond to."
        Exit Sub
    End If
 
    Set oMail = oSel.Item(1)
    Set oReply = oMail.Reply
    oReply.Subject = "Spry Methods --> " & oReply.Subject
    oReply.Body = newtext & oReply.Body
    oReply.Display
End Sub
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
End Sub