saving specific attachments from Outlook to a folder

[Rasberry]

I want to save attachments in my Inbox from a specific sender to a folder I:\Securities\Cash Commitments & Projection\attachment name_date.xls. I have this code in VBA outlook that I lifted from an example, but I can't figure out what to change to make it sender-specific.


Public Sub Application_Startup()

Dim MItem As MailItem
Dim oAttachment As Attachment
Dim sSaveFolder As String
Dim oDefInbox As Folder
Dim targetFolder As Folder
Dim myItems As Outlook.Items
Dim Item As Object

Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
Set targetFolder = Session.GetDefaultFolder(olFolderInbox)

sSaveFolder = "I:\Securities\Cash Commitments & Projection"
For Each MItem In targetFolder.Items
If MItem.UnRead = True Then
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Set oAttachment = Nothing
Next oAttachment
MItem.UnRead = False
End If
Next
End Sub

 

[John_w]

I want to save attachments in my Inbox from a specific sender to a folder I:\Securities\Cash Commitments & Projection\attachment name_date.xls.

Just .xls attachments then? Try this, though not tested within Outlook. The key is getting a collection of Input items using the Restrict method and specifying either the sender's name or their email address.

Public Sub Application_Startup()

    Dim MItem As MailItem
    Dim oAttachment As Attachment
    Dim sSaveFolder As String
    Dim oDefInbox As Folder
    Dim targetFolder As Folder
    Dim myItems As Outlook.Items
    Dim Item As Object
    
    Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
    Set targetFolder = Session.GetDefaultFolder(olFolderInbox)
    
    sSaveFolder = "I:\Securities\Cash Commitments & Projection\"   'Note - ends with \
    
    Dim sender As String
    sender = "Joe Bloggs"
    'sender = "Joe@bloggs.com"
    
    Set myItems = targetFolder.Items.Restrict("[SenderName] = '" & sender & "'")
    'Set myItems = targetFolder.Items.Restrict("[SenderEmailAddress] = '" & sender & "'")
    For Each Item In myItems
        If Item.Class = OlObjectClass.olMail Then
            For Each oAttachment In Item.Attachments
                With oAttachment
                    If LCase(Right(.Filename, 4)) = ".xls" Then
                        .SaveAsFile sSaveFolder & Left(.Filename, InStrRev(.Filename, ".") - 1) & Format(Date, "_yyyymmdd") & Mid(.Filename, InStrRev(.Filename, "."))
                    End If
                End With
            Next oAttachment
        End If
    Next
    
End Sub

 

[Rasberry]

Just .xls attachments then? Try this, though not tested within Outlook. The key is getting a collection of Input items using the Restrict method and specifying either the sender's name or their email address.

Public Sub Application_Startup()

    Dim MItem As MailItem
    Dim oAttachment As Attachment
    Dim sSaveFolder As String
    Dim oDefInbox As Folder
    Dim targetFolder As Folder
    Dim myItems As Outlook.Items
    Dim Item As Object
   
    Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
    Set targetFolder = Session.GetDefaultFolder(olFolderInbox)
   
    sSaveFolder = "I:\Securities\Cash Commitments & Projection\"   'Note - ends with \
   
    Dim sender As String
    sender = "Joe Bloggs"
    'sender = "Joe@bloggs.com"
   
    Set myItems = targetFolder.Items.Restrict("[SenderName] = '" & sender & "'")
    'Set myItems = targetFolder.Items.Restrict("[SenderEmailAddress] = '" & sender & "'")
    For Each Item In myItems
        If Item.Class = OlObjectClass.olMail Then
            For Each oAttachment In Item.Attachments
                With oAttachment
                    If LCase(Right(.Filename, 4)) = ".xls" Then
                        .SaveAsFile sSaveFolder & Left(.Filename, InStrRev(.Filename, ".") - 1) & Format(Date, "_yyyymmdd") & Mid(.Filename, InStrRev(.Filename, "."))
                    End If
                End With
            Next oAttachment
        End If
    Next
   
End Sub

This is the line that won't execute:
Set myItems = targetFolder.Items.Restrict("Passport_Reporting@NTRS.com = '" & sender & "'")
'Set myItems = targetFolder.Items.Restrict("[SenderEmailAddress] = '" & sender & "'")

I have tried it with the brackets and without the brackets. The error message says:

 

[John_w]

Don't change the Restrict line - [SenderName] and [SenderEmailAddress] are named 'conditions' in Outlook.

Since you've specified the user's email address, and not their name, you want to specify the [SenderEmailAddress] condition with their email address. Therefore:

    'sender = "Joe Bloggs"
    sender = "Passport_Reporting@NTRS.com"
 
    'Set myItems = targetFolder.Items.Restrict("[SenderName] = '" & sender & "'")
    Set myItems = targetFolder.Items.Restrict("[SenderEmailAddress] = '" & sender & "'")

 

[Rasberry]

Don't change the Restrict line - [SenderName] and [SenderEmailAddress] are named 'conditions' in Outlook.

Since you've specified the user's email address, and not their name, you want to specify the [SenderEmailAddress] condition with their email address. Therefore:

    'sender = "Joe Bloggs"
    sender = "Passport_Reporting@NTRS.com"
 
    'Set myItems = targetFolder.Items.Restrict("[SenderName] = '" & sender & "'")
    Set myItems = targetFolder.Items.Restrict("[SenderEmailAddress] = '" & sender & "'")

Thank you so much--that doesn't error out, now!! It also saves the file where I want it with today's date. There is only one problem -- it saves each attachment over each other so there is only one file saved. Ideally, I would like each attachment to have the date it was last modified or date of the email. Or, if it is easier to code, simply look at today or yesterday's emails and place that attachment in the file.

 

[John_w]

Ideally, I would like each attachment to have the date it was last modified or date of the email.

This saves the attachments with the date of the email:

                        .SaveAsFile sSaveFolder & Left(.Filename, InStrRev(.Filename, ".") - 1) & Format(Item.ReceivedTime, "_yyyymmdd") & Mid(.Filename, InStrRev(.Filename, "."))

 

[Rasberry]

This saves the attachments with the date of the email:

                        .SaveAsFile sSaveFolder & Left(.Filename, InStrRev(.Filename, ".") - 1) & Format(Item.ReceivedTime, "_yyyymmdd") & Mid(.Filename, InStrRev(.Filename, "."))

Thank works! Outstanding. Thank you!

 

[smozgur]

Thank works! Outstanding. Thank you!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.