Results 1 to 3 of 3

Thread: Automatically Reply specific email with specific subject

  1. #1
    VBAX Newbie
    Jan 2021

    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)


    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")


    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


    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
    End With

    'Update the server and display progress dialog


    End Sub

  2. #2
    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
    Option Explicit
    'Graham Mayor - - 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
        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.
    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
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes

  3. #3
    VBAX Newbie
    Jan 2021
    Thanks the script worked.. Thanks again

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts