Option Explicit
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim MyInbox As Folder
' Папка за которой будем следить
Const fname As String = "Папка_1"

Set Ns = Application.GetNamespace("MAPI")
Set MyInbox = Ns.GetDefaultFolder(olFolderInbox)
Set Items = MyInbox.Folders(fname).Items

End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
' Выбираем категорию которой будем помечать письма 
Const CategoryName As String = "Синяя категория"
If Item.FlagStatus = 1 Then
If Item.Categories <> CategoryName Then
Item.Categories = CategoryName
Item.Save
ReplyMail Item
End If
End If
End Sub

Private Sub ReplyMail(Item As Object)
Dim obj As Object
Dim oReply As Outlook.MailItem
Const sDELIM As String = vbLf
' Префикс автоответа
Const FIX_SUBJECT As String = "АВТО-ОТВЕТ: "
Const BodyPrefix As String = "Работа выполнена." & sDELIM & sDELIM & "-~+~-~+~-~+~-~+~-~+~-~+~-~+~-~+~-" & sDELIM & sDELIM

' Ссылка на открытый в данный момент или выбранный элемента
Select Case True
Case TypeOf Application.ActiveWindow Is Outlook.Inspector
Set obj = Application.ActiveInspector.CurrentItem
Case Else
With Application.ActiveExplorer.Selection
If .Count Then
Set obj = .Item(1)
End If
End With
If obj Is Nothing Then
Exit Sub
End If
End Select

If TypeOf obj Is Outlook.MailItem Then

Set oReply = obj.Reply
If InStr(1, oReply.Subject, FIX_SUBJECT, vbTextCompare) = 0 Then
oReply.Subject = FIX_SUBJECT & obj.Subject
oReply.Body = BodyPrefix & oReply.Body
End If
oReply.Send
End If

End Sub