Outlook Sorting Attachments by key phrase

Question

I am trying to run some VBA code to automatically save attachments based on a phrase in the attachment name to specific folders on my desktop.

   Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
     For Each objAtt In itm.Attachments
        If objAtt.SaveAsFile = "Test1" Then
            saveFolder = "P:\Desktop\Reports\Test1"
        If objAtt.SaveAsFile = "Test2" Then
            saveFolder = "P:\Desktop\Reports\Test2"
        If objAtt.SaveAsFile = "Test3" Then
            saveFolder = "P:\Desktop\Reports\Test3"
        If objAtt.SaveAsFile = "Test4" Then
            saveFolder = "P:\Desktop\Reports\Test4"
        If objAtt.SaveAsFile = "Test5" Then
            saveFolder = "P:\Desktop\Reports\Test5"
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub

It is probably more long winded then it needs to be, but I am hoping you get the idea of what I am trying to do.

I'm not sure I understand the question. When you say "phrase in the attachment name" do you mean something like "FileNamedTest1.ext" should match "Test1"? If that's the case, you can just replace = "Test1" with Like "*Test1*". — Comintern

niton niton · Accepted Answer · 2016-09-30T17:02:12

Instr will indicate whether the phrase is in the Displayname.

Private Sub saveAttachtoDisk(itm As mailItem)

    Dim objAtt As attachment
    Dim saveFolder As String

    For Each objAtt In itm.Attachments

        saveFolder = ""
        Debug.Print objAtt.DisplayName

        If InStr(LCase(objAtt.DisplayName), LCase("Test1")) > 0 Then
            saveFolder = "P:\Desktop\Reports\Test1"
        End If

        If InStr(LCase(objAtt.DisplayName), LCase("Test2")) > 0 Then
            saveFolder = "P:\Desktop\Reports\Test2"
        End If

        ' ....

        If saveFolder <> "" Then
            objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        Else
            MsgBox "No match. " & objAtt.DisplayName & " not saved."
        End If
    Next

    If objAtt Is Nothing Then
         Debug.Print "objAtt is already Nothing."
    Else
        MsgBox "Somehow objAtt was not nothing."
        Set objAtt = Nothing
    End If

End Sub

Outlook Sorting Attachments by key phrase

1 Answers