Outlook VBA to Save Multiple Attachments as Different Names - vba

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: