OUTLOOK - Prefab_Reply_from_html_file.vba

Prefab_Reply_from_html_file.vba

' Canned reply using external html
Public Sub PREFAB_REPLYNew()
Dim oMailReply, oMailSelect As Outlook.MailItem, Keyword5 As String
Dim oFSO, oFS, BodyText, SubjString, EmpFirst, EmpLast, BodyReply


If Application.ActiveExplorer.Selection.Count Then
    
    
    If TypeOf Application.ActiveExplorer.Selection(1) Is Outlook.MailItem Then
        Set oMailReply = Application.ActiveExplorer.Selection(1).Reply
        Set oMailSelect = Application.ActiveExplorer.Selection(1)
        BodyText = oMailSelect.Body ' Pass BodyText the full contents of the message body
        If InStr(LCase(oMailReply), "PREFAB_REPLY") Then
        
            ' Pull in template file
            Set oFSO = CreateObject("Scripting.FileSystemObject")
            Set oFS = oFSO.OpenTextFile("\\network_share\Folders\PREFAB_REPLY_new.html")
            
            sText = oFS.readall
            oMailReply.BodyFormat = olFormatHTML 'convert the message to HTML
            oMailReply.HTMLBody = "<i><font color=gray PREFAB_REPLYe=calibri>" & _
            oMailReply.HTMLBody & "</i></font>"

            'Define new reply body to include template file
            oMailReply.Body = sText & vbCr & oMailReply.HTMLBody
            oMailReply.SentOnBehalfOfName = "your_account_name"
            SubjString = oMailReply.Subject
            SubjString = Replace(SubjString, (LCase("keyword1")), "substitute1")
            SubjString = Replace(SubjString, (LCase("keyword2")), "substitute2")
            oMailReply.Subject = SubjString
            
            '--------begin recipient parsing
            msgLines = Split(BodyText, vbCrLf)                ' Break apart body into separate lines
            For Each msgLine In msgLines                      'Scan each line

                If InStr(LCase(msgLine), "is requesting") Then
                    Dim RecpNameArray() As String
                    Recipient = Replace(msgLine, " ", ".")
                    RecpNameArray = Split(Recipient, ".")
                    RecpNameArray(0) = StrConv(RecpNameArray(0), vbProperCase)
                    RecpNameArray(1) = StrConv(RecpNameArray(1), vbProperCase)
                    Recipient = RecpNameArray(0) + "." + RecpNameArray(1)
                    EmpFirst = RecpNameArray(0)
                    EmpLast = RecpNameArray(1)
                    oMailReply.To = Recipient

                    ElseIf InStr(LCase(msgLine), "keyword3") Then
                        Keyword5 = Mid(msgLine, 14)
                        Keyword5 = "(" & Keyword5 & ")"
                    End If
            
                    
                    If (Not Keyword5 = "") And (Not Recipient = "") Then
                        Exit For
                    End If
            Next
            
        
        
        ' Resolve all recipients
        oMailReply.Recipients.ResolveAll


        ' ----------Begin message prep
        oMailReply.HTMLBody = "<font size=3 color=blue PREFAB_REPLYe=Calibri>Hello " & StrConv(EmpFirst, vbProperCase) & _
        vbCrLf & oMailReply.Body
        
        oMailReply.Display
        
        Set BodyText = Nothing
        Set SubjString = Nothing
        
    End If
End If
End If
End Sub