Sub ReplyMSG()
'Graham Mayor - https://www.gmayor.com - Last updated - 18 Jul 2023
Dim olItem As Outlook.MailItem
Dim olAccount As Outlook.Account
Dim olReply As MailItem    ' Reply
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim bAcc As Boolean
Const strAcc As String = "Juan Cabrera"    'use the display name of the account here

    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select

    For Each olAccount In Application.Session.Accounts
        If olAccount.DisplayName = strAcc Then
            bAcc = True
            Set olReply = olItem.ReplyAll
            With olReply
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "Am currently working on your quote, I should have it done today or first tomorrow morning. " & _
                            "Any question, please feel free to email directly."
                oRng.collapse 0
                oRng.Text = vbCr & vbCr & "Item 1" _
                            & vbCr & vbCr & "Item 2" _
                            & vbCr & vbCr & "Item 3"
                .SendUsingAccount = olAccount
                .Display
                .Send
            End With
            Exit For
        End If
        olItem.Categories = "Juan Cabrera"
        olItem.Close olSave
    Next olAccount
    If bAcc = False Then
        MsgBox strAcc & " account not found!", vbCritical
    End If
lbl_Exit:
    Set olItem = Nothing
    Set olReply = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olAccount = Nothing
    Exit Sub
End Sub