Automatically Reply specific email with specific subject

i am new to outlook vba. Trying to write a macro script to reply to specific email with specific subject.<br><br>Please find my code below. dont know what am missing out

Sub GioleeRule()


Dim colStores As Outlook.Stores

Dim oStore As Outlook.Store

Dim oRoot As Outlook.Folder

Dim colRules As Outlook.Rules

Dim oRule As Outlook.Rule

Dim colRuleActions As Outlook.RuleActions

Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction

Dim oFromCondition As Outlook.ToOrFromRuleCondition

Dim oConditionSubject As Outlook.TextRuleCondition

Dim oInbox As Outlook.Folder


Dim oReplyAll As MailItem



'Specify target folder for rule move action

Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)


'Get Rules from Session.DefaultStore object

On Error Resume Next

Set colStores = Application.Session.Stores

For Each oStore In colStores

Set oRoot = oStore.GetRootFolder

Debug.Print (oRoot.FolderPath)

Next


Set colRules = Application.Session.DefaultStore.GetRules()

'Create the rule by adding a Receive Rule to Rules collection

Set oRule = colRules.Create("dumexy's rule", olRuleReceive)


'Specify the condition in a ToOrFromRuleCondition object

'Condition is if the message is sent by "email"

Set oFromCondition = oRule.Conditions.From

With oFromCondition

.Enabled = True

.Recipients.Add ("email")

.Recipients.ResolveAll

End With


'Specify the condition for the subject in a TextRuleCondition object

'condition is if the subject contains "fun" or "chat"

Set oConditionSubject = oRule.Conditions.Subject


oRule.Conditon.Subject

With oConditionSubject

.Enabled = True

.Text = Array("fun", "chat")

End With

With oReplyAll
'Type Your Own Auto Reply
'Change "My Name" to Your Own Name
.Body = "Yes." & vbCrLf & vbCrLf & "-------Original Message-------" & vbCrLf & "From: " & Item.Sender & "[mailto: " & Item.SenderEmailAddress & "]" & vbCrLf & "Sent: " & Item.ReceivedTime & vbCrLf & "To: YourName" & vbCrLf & "Subject: " & Item.Subject & vbCrLf & Item.Body
.Send
End With

'Update the server and display progress dialog

colRules.Save

End Sub

I am not sure of the benefit of using a macro to create a rule. If you want to reply automatically to messages that contain "fun" or 'chat' in the subject, then you need to create a rule that acts on all incoming messages to run the following script. If scripts do not appear in the rules dialog - see https://www.slipstick.com/outlook/ru...-script-rules/

Code:

---

Option Explicit

'Graham Mayor - https://www.gmayor.com - Last updated - 14 Jan 2021
Sub AutomaticReply(olItem As Outlook.MailItem)
Dim olOutMail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim vSub As Variant
Dim i As Integer
Dim bFound As Boolean

    vSub = Array("fun", "chat")

    If Not TypeName(olItem) = "MailItem" Then Exit Sub

    For i = 0 To UBound(vSub)
        If InStr(1, LCase(olItem.Subject), vSub(i)) > 0 Then
            bFound = True
            Exit For
        End If
    Next i

    If bFound = True Then
        Set olOutMail = olItem.ReplyAll
        With olOutMail
            .BodyFormat = olFormatHTML
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.collapse 1
            oRng.Text = "Yes" & vbCr 'The reply message
            .Display    'required
            '.Send 'enable after testing
        End With
    End If

lbl_Exit:
    Set olOutMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---

You can run the following macro to test the code. Select a message with 'fun' or 'chat' in the subject and run the macro. If the strings are no found or the message is an meeting nothing happens.

Code:

---

Sub TestMacro()
Dim olMsg As MailItem
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.currentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.Item(1)
    End Select
    AutomaticReply olMsg
lbl_Exit:
    Exit Sub
End Sub

---

Thanks the script worked.:yes:yes. Thanks again