Tuesday, March 29, 2016

Outlook VBA Macro to group unread email with subject containing Excel & forward all email as attachment to specific email ID

Query: I want to automate incoming emails on the basis of its subject, if this contains word excel I want to attach all such email to new email as a mail item & forward it to particular email ID.


We can create loop for all unread email in outlook & check whether it is unread & contains word Excel, and if contains then add email item as an attachment & forward to defined recepient.

Option Explicit

Sub ConsolEmail()

Dim objMailItems As Items

Dim objMail As Object

Dim ns As NameSpace

Dim mFound As Boolean

Set ns = Application.GetNamespace("MAPI")

Set objMailItems = ns.GetDefaultFolder(olFolderInbox).Items


'Assign the email address to forward items to

Dim msgList As String

msgList = "vba@vabs.in"


'Assign Subject

Dim msgSub As String

msgSub = "Excel"

mFound = False

'Create new email

Dim objNewMail As Object

Set objNewMail = Application.CreateItem(olMailItem)


'Forward each item as attachment

For Each objMail In objMailItems

'Debug.Print objMail.Subject

    If objMail.UnRead = True And _

     InStr(1, objMail.Subject, msgSub, vbTextCompare) > 1 Then

    objNewMail.Attachments.Add objMail

    objMail.UnRead = False

    mFound = True

    End If


If mFound Then

objNewMail.To = msgList

objNewMail.Subject = "Group email for " & msgSub



'objNewMail.Send ' untag this line for sending email instead of displaying

End If

MsgBox "One operation completed"


Set objMail = Nothing

Set objMailItems = Nothing

Set objNewMail = Nothing

End Sub

Do give your feedback & post your query on form www.ExcelVbaLab.com



No comments:

Post a Comment