Select email that triggers script - vba

Question

I am working on a Outlook script that will automatically select an email, and download the attachments, from a specific sender.
Reports are generated on a database and emailed to a specified address.
The next step is to automatically download those reports to a specified folder. Currently if an email comes in from the specified sender the script downloads attachments from the currently selected email.
I need the script to run on the email that triggers the script.
Public Sub SaveAttachments(Item 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 strDeletedFiles As String
'Get the path to the target folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
'Instantiate an Outlook Application Object
Set objOL = CreateObject("Outlook.Application")
'Get the collection of selected objects
Set objSelection = objOL.ActiveExplorer.Selection
'Set the Attachment folder
strFolderpath = strFolderpath & "\Attachments\"
'Check each selected item for attachements. If attachments exist, save them
'to the strFOlderPath folder and strip them from the item.
For Each objMsg In objSelection
'This code only strips attachments from mail items.
'If objMsg.class=olMail Then
'Get the Attachments collection of the item
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFile = ""
If lngCount > 0 Then
'A count down loop needs to be used for removing items
'from a collection. Otherwise the loop counter gets
'confused and only every other item is removed
For i = lngCount To 1 Step -1
'Save attachment before deleting from item.
'Get the file name
strFile = objAttachments.Item(i).FileName
'Combine with the path to the Temp folder.
strFile = strFolderpath & strFile
'Save the attachment as a file
objAttachments.Item(i).SaveAsFile strFile
'Delete the attachment
objAttachments.Item(i).Delete
'write the save as path to a string to add to the
'message check from html and use html tags in link
If objMsg.BodyFormat <> olFormatHTML Then
strDeletedFile = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If
'use the MsgBox command to troubleshoot. Remove it from the final code.
'MsgBox strDeletedFiles
Next i
'Adds the filename string to the message body and save it
'Checks for HTML body
If objMsg.BodyFormat <> olFormatHTML Then
objMsg.Body = vbCrLf & "The File(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
Else
objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
End If
objMsg.Save
End If
Next
Exit Sub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Answer 1

I made some changes and this code does the intended purpose.
Public Sub SaveAttachments(Item As Outlook.MailItem)
Dim objOL As Outlook.Application
Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
'Get the path to the target folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
'Instantiate an Outlook Application Object
Set objOL = CreateObject("Outlook.Application")
'Set the Attachment folder
strFolderpath = strFolderpath & "\Attachments\"
'Check each selected item for attachements. If attachments exist, save them
'to the strFOlderPath folder and strip them from the item.
For Each objAttachments In Item.Attachments
'This code only strips attachments from mail items.
'If objMsg.class=olMail Then
'Get the Attachments collection of the item
Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
strDeletedFile = ""
If lngCount > 0 Then
'A count down loop needs to be used for removing items
'from a collection. Otherwise the loop counter gets
'confused and only every other item is removed
For i = lngCount To 1 Step -1
'Save attachment before deleting from item.
'Get the file name
strFile = objAttachments.Item(i).FileName
'Combine with the path to the Temp folder.
strFile = strFolderpath & strFile
'Save the attachment as a file
objAttachments.Item(i).SaveAsFile strFile
'Delete the attachment
objAttachments.Item(i).Delete
'write the save as path to a string to add to the
'message check from html and use html tags in link
If Item.BodyFormat <> olFormatHTML Then
strDeletedFile = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If
'use the MsgBox command to troubleshoot. Remove it from the final code.
'MsgBox strDeletedFiles
Next i
'Adds the filename string to the message body and save it
'Checks for HTML body
If Item.BodyFormat <> olFormatHTML Then
Item.Body = vbCrLf & "The File(s) were saved to " & strDeletedFiles & vbCrLf & Item.Body
Else
Item.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & Item.HTMLBody
End If
Item.Save
End If
Next objAttachments
Exit Sub:
Set objAttachments = Nothing
Set objOL = Nothing
End Sub

Answer 2

To apply code to the item, do not select anything.
Instead use Item passed in (Item As MailItem).
In the question and the answer posted by the OP, if strFolderpath does not exist, the error when saving will be bypassed.
The attachments will be unrecoverably deleted without being saved.
This is due to improper use of On Error Resume Next.
"There are specific occasions when this is useful. Most of the time you should avoid using it."
https://excelmacromastery.com/vba-error-handling#On_Error_Resume_Next
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Private Sub test()
SaveAttachments ActiveInspector.currentItem
End Sub
Public Sub SaveAttachments(Item As MailItem)
'Check the Item passed in (Item As MailItem) for attachments.
'
'If attachments exist,
' save them to the strFolderpath folder and
' strip them from the item.
Dim objAttachment As Attachment
Dim objAttachments As Attachments
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
'Get the path to the target folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
Debug.Print strFolderpath
'Set the Attachment folder
strFolderpath = strFolderpath & "\Attachments\"
Debug.Print strFolderpath
'Get the Attachments collection of the item
Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
'A count down loop for removing items, through move or delete, from a collection.
'Otherwise only every other item is removed.
For i = lngCount To 1 Step -1
'Save attachment before deleting from item.
'Get the file name
strFile = objAttachments(i).fileName
Debug.Print strFile
'Combine the path to the folder with file name.
strFile = strFolderpath & strFile
Debug.Print strFile
'Save the attachment as a file
'If strFolderpath does not exist there will be an error.
'This is good.
objAttachments.Item(i).SaveAsFile strFile
'Delete the attachment
' Uncomment after verifying attachments are being saved
'objAttachments.Item(i).Delete
'Write the save as path to a string to add to the message
'Check from html and use html tags in link
If Item.BodyFormat <> olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If
Next
'Add the filename string to the message body and save it
'Check for HTML body
If Item.BodyFormat <> olFormatHTML Then
Item.body = vbCrLf & "The File(s) were saved to " & strDeletedFiles & vbCrLf & Item.body
Else
Item.HtmlBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & Item.HtmlBody
End If
Item.Display 'Item.Save
End Sub

Answer 3

You pass the mailitem that triggers the script as a parameter.
If, for example, you pass Item then process Item.
Sub CustomMailMessageRule(Item As MailItem)
MsgBox "Mail message arrived: " & Item.Subject
End Sub