Outlook 2007 - Automatically save attachment

Here is the situation, you receive daily emails through Outlook, and most of these mails include attachment, once you forgot to download those attachments for a while, you will need to spend lots of time to download it.



Now, here is the way to reduce your work load:

1. Create a VB Script in Outlook.

Open Outlook → Tools → Macro → Visual Basic Editor

Public Sub SaveAttachment(objMsg As Outlook.MailItem)
    Dim objAttachments  As Outlook.Attachments
    Dim objSelection    As Outlook.Selection
    Dim i               As Long
    Dim lngCount        As Long
    Dim strFile         As String
    Dim strExt          As String
    Dim strFolderpath   As String
    Dim strSaveFile     As String
    Dim dateFormat      As String
    Dim subject         As String
   
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    subject = objMsg.subject

    'File name not allowed the symbol ":"
    subject = Replace(Replace(subject, "FW: ", ""), ":", "")

    'According to different client, save the attachment in different folder
    If InStr(objMsg.SenderEmailAddress, "ClientA_Keyword") > 0 Or InStr(subject, "ClientA_Keyword") > 0 Then
        strFolderpath = "C:\Users\User_Name\Documents\ClientA\"
    ElseIf InStr(objMsg.SenderEmailAddress, "ClientB_Keyword") > 0 Or InStr(subject, "ClientB_Keyword") > 0 Then
        strFolderpath = "C:\Users\User_Name\Documents\ClientB\"
       End If
   
    If lngCount > 0 Then
        For i = 1 To lngCount
            strFile = objAttachments.Item(i).FileName
           
            'According to different title or attachment name, save
            If InStr(subject, "Act") > 0 Or InStr(strFile, "Act") > 0 Then
                strFolderpath = strFolderpath & "Act\"
            ElseIf InStr(subject, "Cyc") > 0 Or InStr(strFile, "Cyc") > 0 Then
                strFolderpath = strFolderpath & "Cyc\"
            End If
 
            'In case we can't identify the file after we save it
            If InStr(subject, "Act") < 0 And InStr(strFile, "Act") > 0 Then
                strFile = strFile & "-Act"
            ElseIf InStr(subject, "Cyc") < 0 And InStr(strFile, "Cyc") > 0 Then
                strFile = strFile & "-Cyc"
            End If
           
            'Avoid to overwrite the file which the name is the same
            dateFormat = Format(objMsg.ReceivedTime, "(yyyy-mm-dd hhmmss)")
            strFile = subject & dateFormat & Right(strFile, 4)
            strSaveFile = strFolderpath & strFile
            objAttachments.Item(i).SaveAsFile (strSaveFile)
        Next i
    End If 

2. Set the rules to run the VB script

Tools → Rules and Alerts → New Rule
→ I select Move messages from someone to a folder
→ edit people or distribution list and select which has an attachment
→ edit specified folder and select run a script, click a script, and select the script you created.

This method needs to keep Outlook on opening status, but what if odd situations happen, for example, Outlook lost connection or fail to connect to Exchange Server, or power shutdown, then I suggest reopen Outlook and manually execute rules, see the following steps:

Tools → Rules and Alerts → Run Rules Now... → Select all rules and click Run Now button