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

Status
Not open for further replies.

Bob Jensen

New Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
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-

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Outlook rules (and Script ) are raised for each Email.
To create a new mail you need to wait the 3rd Email.

Code:
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
 
Status
Not open for further replies.
Top