Outlook VBA to Save Multiple Attachments as Different Names

Question

This is what I have so far:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "P:\ME\TEST\"
Dim dateFormat
dateFormat = Format(Now, "yyyy.mm.dd")
 For Each objAtt In itm.Attachments
        If InStr(objAtt.FileName, "ASDFA ADSF.pdf", vbTextCompare) > 0 Then
      objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ASDF.pdf"
        ElseIf InStr(objAtt.FileName, "GASD.pdf", vbTextCompare) > 0 Then
        objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ADSF ADD.pdf"
        ElseIf InStr(objAtt.FileName, "ASDF AD.pdf", vbTextCompare) > 0 Then
        objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ASDF.pdf"
        ElseIf InStr(objAtt.FileName, "ASDF AS.pdf", vbTextCompare) > 0 Then
        objAtt.SaveAsFile saveFolder & dateFormat & " asd asdf.pdf"
        Else
        objAtt.SaveAsFile saveFolder & "Caught"
  End If
  Set objAtt = Nothing
 Next
End Sub

I used random letters just for privacy. I'm trying to get outlook to autosave email attachments as specific names with date in front using rules and VBA. What am I doing wrong here?

Answer 1

My guess is you don't have permission to write to P:\\ME\\TEST\\ or you aren't getting inside your If statements to save.

You want to set your If lines to be a > 0 :

If InStr(objAtt.DisplayName, "BBB AAA.pdf") > 0 Then

If any character is in the first position other than that name, then it will not go inside the If . Of course, that may also be the behavior you want.

You can test if it is not hitting inside the If statments by adding:

Else
    objAtt.SaveAsFile saveFolder & "not caught.pdf"
End If

If you don't get a save after adding the Else code, try saving to your local documents folder. Then, if you still don't get any saves, the MailItem doesn't have any attachments.

EDIT: Should look like this: