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.

Solution:

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

Next



If mFound Then

objNewMail.To = msgList

objNewMail.Subject = "Group email for " & msgSub

'objNewMail.Save

objNewMail.Display

'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

Cheers!

#Tag : #OUTLOOK #VBA #MACRO #TO #GROUP #UNREAD #EMAIL #WITH #SUBJECT #CONTAINING #EXCEL & #FORWARD #ALL #EMAIL #AS #ATTACHMENT #TO #SPECIFIC #EMAIL #ID