CODEWITHSUNDEEP
vbaoutlook
user2906801
user2906801

Reputation:

Outlook Sorting Attachments by key phrase

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.

Upvotes: 0

Views: 70

Answers (1)

niton
niton

Reputation: 9179

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

Upvotes: 0

Related Questions