Rule does not run when a new email comes in - vba

Question

I worked out the code below to save an attachment to an email, to a mapped network drive, based on the subject line. However the rule in Outlook 2010 (xp OS) doesn't work when a new email comes in. It doesn't save it to the specified location. When I run the rule manually it works great.
I have enabled all macros. restarted Outlook no change. I have made macros prompt when running. It prompts when a new email comes in. I hit enable no save, no error that it didn't save.
Public Sub SaveAttachments2(mail As Outlook.MailItem)
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim f As String
Dim strSubject As String
Dim w As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
For Each Item In Inbox.Items
strSubject = Item.Subject
f = strSubject
Rem MkDir ("Z:\OPERATIO\AS400_Report\" & f)
For Each Atmt In Item.Attachments
FileName = "Z:\OPERATIO\AS400_Reports\" & f & "\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
'commented out and added rule option to delete the item
Next Atmt
'Item.Delete
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveAttachments2" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
'added next because of compile error
Next
End Sub

Answer 1

You cannot change standalone VBA by simply adding (mail As Outlook.MailItem).
Public Sub SaveAttachments2(mail As Outlook.mailItem)
Dim Atmt As attachment
Dim FileName As String
Dim f As String
f = Trim(mail.Subject) ' Removes spaces at ends. This is a big problem.
On Error Resume Next
MkDir ("Z:\OPERATIO\AS400_Report\" & f) ' Creates a folder if it does not exist
On Error GoTo GetAttachments_err
For Each Atmt In mail.Attachments
FileName = "Z:\OPERATIO\AS400_Reports\" & f & "\" & Atmt.FileName
Atmt.SaveAsFile FileName
' Fails on subjects with illegal characters.
' For example when RE: and FW: in the subject the folder cannot be created.
Next Atmt
GetAttachments_exit:
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveAttachments2" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub
See here if illegal characters cause problems creating folders. Save mail with subject as filename