Save Attachment on arriving email - vba

Question

I created an Outlook rule to save an attachment then move it to the Deleted Items folder. The code works when I highlight the arrived email in the Inbox then move the email to the Deleted Items folder.
When the new email arrives, it is saving the attachment(s) from different email in the inbox and not moving the email to the Deleted Items folder.
The Outlook rule is:
Apply this rule after the message arrives
from Sender
and with Gift Card in the subject
and on this computer only
run Project1.SaveAttachments
Public Sub SaveAttachments(MItem As Outlook.Mailitem)
Dim objOL As Outlook.Application
Dim objMsg As Outlook.Mailitem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim objNamespace As Outlook.NameSpace
Dim objDestFolder As Outlook.MAPIFolder
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
strFolderpath = "Y:\"
For Each objMsg In objSelection
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""
If lngCount > 0 Then
For i = lngCount To 1 Step -1
strFile = objAttachments.Item(i).FileName
strFile = strFolderpath & strFile
objAttachments.Item(i).SaveAsFile strFile
Next i
Set objNamespace = objOL.GetNamespace("MAPI")
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)
objMsg.Move objDestFolder
End If
Next
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Set objNamespace = Nothing
Set objDestFolder = Nothing
End Sub

Answer 1

According to my test, you could save email attachment and delete it using the below code:
Sub SaveAutoAttach()
Dim object_attachment As Outlook.attachment
Dim saveFolder As String
Dim oOutlook As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim unRead, m As Object, att As Object
Dim some As String, other As String
Const olFolderInbox = 6
'~~> Get Outlook instance
Set oOutlook = GetObject(, "Outlook.application")
Set oOlns = oOutlook.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
Set unRead = oOlInb.Items.Restrict("[UnRead] = True")
If unRead.Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Else
some = ""
other = ""
saveFolder = "D:\"
For Each m In unRead
If m.Attachments.Count > 0 Then
For Each object_attachment In m.Attachments
' Criteria to save .doc files only
If InStr(object_attachment.DisplayName, ".doc") Then
object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
End If
Next
End If
m.Delete
Next m
End Sub
For more information, please refer to this link:
Auto Download Outlook Email Attachment – Code in VBA by Topbullets.com