Sub ReplyMSG()
'Graham Mayor - Graham Mayor - Home Page - 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@pdmsteel.com" '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