Save Outlook 2003 E-mail Attachments Automatically

In Outlook 2007 Add-in: Saving Outlook e-mail attachments automatically, author Robert Martim demonstrates how to write an add-in for Outlook 2007 using VSTO that saves file attachments on incoming e-mails automatically.

I've demonstrated the same using VBA in Outlook 2003 below. It uses the stock event code I use when creating event handlers in Outlook.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
  Set objNS = GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler

  Dim filePath As String
  Dim atts As Outlook.Attachments
  Dim att As Outlook.Attachment
  Dim Msg As Outlook.MailItem

  filePath = Environ("userprofile") & "\Desktop\E-Mail Attachments\"

  If Dir(filePath, vbDirectory) = "" Then
    MkDir filePath
  End If

  If TypeName(item) <> "MailItem" Then GoTo ProgramExit

  Set Msg = item

  ' loop through attachments, save each one to folder
  Set atts = Msg.Attachments

  For Each att In atts
    With att
      .SaveAsFile filePath & .DisplayName
    End With
  Next att

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.number & " - " & Err.Description
  Resume ProgramExit
End Sub

The path is hardcoded; if it doesn't exist, we'll create it. Then we'll loop through the Attachments collection of the incoming email and save each one to the designated folder.

Related Articles:

• December 17, 2009 -- Strip selected attachments and save to folder
• September 14, 2009 -- Automatically triage emails by sender name
• January 7, 2009 -- Handling Multiple Inboxes