Thanks so much guys, I have this working perfectly!!!

One quick follow up question:

Once the email is forwarded (to the same inbox infact) I have another rule that reads out the subject line of the email, code here:



Public Sub AnnounceMail(Item As Outlook.MailItem)
Dim currenttime As Date

currenttime = Now
Do Until currenttime + TimeValue("00:00:02") <= Now
Loop

Dim xlApp As Object

Dim strFrom As String
Dim strMessageType As String
Dim ReadOutText As String

Set xlApp = CreateObject("Excel.Application")

strFrom = Split(Item.Sender, " ")(0)
strMessageType = Right(Item.Subject, 3)


Select Case strMessageType
Case "RE:"
ReadOutText = ReadOutText & strFrom & " replied to an email regarding, " & Item.ConversationTopic
Case "FW:"
ReadOutText = ReadOutText & strFrom & " Forwarded an email regarding, " & Item.ConversationTopic
Case Else
ReadOutText = ReadOutText & Item.ConversationTopic
End Select

ReadOutText = ReadOutText & "."

xlApp.Speech.Speak ReadOutText
xlApp.Quit

Set xlApp = Nothing


End Sub



I cannot ssem to figure out how i can add this script along with the below, how do I create a second VBA script to setup with a second rule?


Thanks again

Simmons




Quote Originally Posted by gmayor View Post
An alternative approach, which you can use as a script with a rule, to reply automatically as the messages arrive is as follows:
Sub AutoResponse(olItem As MailItem)
Dim sText As String
Dim sSubject As String
Dim vText As Variant, vItem As Variant
Dim i As Long
Dim olOutMail As Outlook.MailItem

    sText = olItem.Body
    vText = Split(sText, Chr(13))
    sSubject = ""
    For i = 1 To UBound(vText)
        If InStr(1, vText(i), "5.tour_booked : ") > 0 Then
            vItem = Split(vText(i), Chr(58))
            sSubject = sSubject & Trim(vItem(1))
        End If
        If InStr(1, vText(i), "5.tour_price : ") > 0 Then
            vItem = Split(vText(i), Chr(58))
            sSubject = sSubject & Chr(32) & Trim(vItem(1))
        End If
    Next i
    Set olOutMail = Application.CreateItem(olMailItem)
    With olOutMail
        .To = "EMAIL" ' the recipient of the message
        .Subject = sSubject
        .Display 'Change to .Send after testing
    End With
lbl_Exit:
    Set olOutMail = Nothing
    Exit Sub
End Sub
Use the following to test on a message already received.

Sub TestMsg()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    AutoResponse olMsg
lbl_Exit:
    Exit Sub
End Sub