Hi,

I am trying to capture a newly arrived mail in outlook with respective subject line.
The below code works for me on 2010 outlook but not working on 2013 outlook.

Option Explicit


Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' (1) default Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub


Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim objMsg As MailItem
Dim myAttachments As Outlook.Attachments
Dim FilePath As String
Dim Att As String
Dim MSubject, MBody As Variant
Const attPath As String = "D:\Attachment\" 'Attached file saved ,change if required


Set objMsg = Application.CreateItem(olMailItem)
Set Msg = item

' (2) only act if it's a MailItem
If TypeName(item) = "MailItem" Then

If Msg.Subject Like "*Weekly quality dashboar*" Then 'Change subject as per the required mail

Set myAttachments = Msg.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
With objMsg
.To = "[email protected]>
.Subject = Msg.Subject
'now attach it to the new message
.Attachments.Add (attPath & Att)
'.Attachments = Msg.Attachments
.Body = Msg.Body
.Display
End With
objMsg.Send
End If
End If

Set objMsg = Nothing
ProgramExit:
Set objMsg = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub