Mason Chambers
Mason Chambers

Reputation: 173

How can I save attachments with different criteria into two different folders in Outlook?

I get 2 different files forwarded to me in Outlook daily. I currently use the code below to automatically download the attachments that meet the criteria to a folder on my drive.

I was wondering if there is a way to edit this so that I can save the different files to two different folders. i.e. email with A in subject => save attachment to folder A, email with B in subject => save attachment to folder B.

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oOutlookAttachment As Outlook.Attachment
    Dim sSaveAttachmentsFolder As String
    sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\"
    For Each oOutlookAttachment In MItem.Attachments
        oOutlookAttachment.SaveAsFile sSaveAttachmentsFolder & 
        oOutlookAttachment.DisplayName
    Next
End Sub

I know nothing about VBA, I just found this code online.

Upvotes: 2

Views: 375

Answers (2)

AAA
AAA

Reputation: 3670

Since it's a binary criterion (A or B), we don't need to consider both strings: if it contains A, save to folderA. Else (which means it contains B) save to folderB.

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)

    Dim oAttach As Outlook.Attachment
    Dim FolderA As String, FolderB As String, StringA As String

    FolderA = "C:\Users\mason\Desktop\Email Fast Racks\"
    FolderB = "C:\Users\mason\Desktop\Email FTS Pricing\"
    StringA = "Fast Racks East Coast"
    For Each oAttach In MItem.Attachments

            If UCase(oAttach.FileName) Like "*.CSV" Then
                If InStr(MItem.Subject, StringA) > 0 Then
                    oAttach.SaveAsFile FolderA & oAttach.DisplayName
                Else
                    oAttach.SaveAsFile FolderB & oAttach.DisplayName
                End If
            End If

    Next oAttach

End Sub

Upvotes: 1

0m3r
0m3r

Reputation: 12499

You could also simply use Select Case

Example

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oOutlookAttachment As Outlook.Attachment
    Dim sSaveAttachmentsFolder As String

    Debug.Print MItem.Subject

    Select Case MItem.Subject
            '// subject line A
        Case "AAAA"
            sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\AAAA\"
            '// subject line B
        Case "BBBB"
            sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\BBBB\"
        Case Else
            Debug.Print "Subject not found"
            Exit Sub
    End Select

    For Each oOutlookAttachment In MItem.Attachments
        oOutlookAttachment.SaveAsFile sSaveAttachmentsFolder & oOutlookAttachment.DisplayName
    Next
End Sub

Upvotes: 0

Related Questions