1. Start Outlook.
2. Click Tools->Macro->Visual Basic Editor.
3. If not already expanded, expand Modules and click on Module1.
4. Copy the code below and paste it into the right-hand pane of the VB Editor.
5. Edit the code as needed. I placed comment lines where things need to change.
6. Click the diskette icon on the toolbar to save the changes.
7. Close the VB Editor.
8. Click Tools->Macro->Security.
9. Change the Security Level setting to Medium.
10. Create a rule that runs when a new message arrives. Set it to check the subject for the text you want to trigger on. If found, set the rule to move the message to the "Car Mileage Claim" folder and to run the macro. The order is immaterial. The final rule should look something like this:
Apply this rule after the message arrives
with Car Mileage Claim in the subject
and on this machine only
move it to the Car_Mileage folder
and run Modules.SaveAttachmentsToDiskRule
Sub SaveAttachmentsToDiskRule(olkMessage As Outlook.MailItem)
Dim olkAttachment As Outlook.Attachment, _
objFSO As Object, _
strRootFolderPath As String, _
strFilename As String
'Change the path on the following line to the folder you want the attachments save in
strRootFolderPath = "C:\Car_Mileage_Attachments\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
If olkMessage.Attachments.Count > 0 Then
For Each olkAttachment In olkMessage.Attachments
strFilename = olkAttachment.FileName
intCount = 0
Do While True
If objFSO.FileExists(strRootFolderPath & strFilename) Then
intCount = intCount + 1
strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
Else
Exit Do
End If
Loop
olkAttachment.SaveAsFile strRootFolderPath & strFilename
Next
End If
Set objFSO = Nothing
Set olkAttachment = Nothing
Set olkMessage = Nothing
End Sub
