Auto Save of Attachments from Multiple Emails and forward attachments to user group

[Bob Jensen]

Each day I get (3) emails from the same sender. Each email has (1) attachment. I save each attachment to a network folder. I then take the (3) saved attachments from today and create a new email with these files as attachments. Then the email is send to a distribution group.

I can use Outlook rules and Script to automate the save of each the initial attachments.

Script is:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "m:\Attachments"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

However, some help on automating taking those saved attachments, attaching them into a new email, and sending to a distribution list is appreciated.

 

[oliv-]

Outlook rules (and Script ) are raised for each Email.
To create a new mail you need to wait the 3rd Email.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "m:\Attachments"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & objAtt.displayName
        Set objAtt = Nothing
    Next
    Call createMailWithAttachments
End Sub

Sub createMailWithAttachments()
    Dim saveFolder As String
    saveFolder = "m:\Attachments"
    Dim FSO, oSourceFolder
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = FSO.GetFolder(saveFolder)
    If oSourceFolder.Files.Count = 3 Then
        Dim itm
        Dim objfile
        Set itm = CreateItem(olMailItem)

        For Each objfile In oSourceFolder.Files
            itm.Attachments.add objfile.path
        Next
        itm.To = "to@toto.com"
        itm.Object = "subject"
        itm.Display
        itm.Send
    End If
End Sub