Saving attachments from multiple emails

  • Thread starter Thread starter tryer
  • Start date Start date
T

tryer

Hi, I'm new to VBA in outlook (though have been learning with excel)
I'm looking for a way to save the attachments from multiple emails int
a single folder automatically then mark the emails as read.
Ideally I would like to select all the emails and process th
selection, if this is not possible then I could move them all to
specific folder first.

Any help in pointing me in the right direction would be appreciated :
 
I have some sample code here: http://www.codeforexcelandoutlook.com/blog/2008/08/processing-multiple-emails/

This code might also be useful. It loops through selected emails,
saves their attachments to a folder on your desktop, then marks the
email as read.

Sub SaveAttach()
' saving attachments from multiple emails to a single folder on drive

Dim Msg As Outlook.MailItem
Dim MsgColl As Object
Dim MsgAttach As Outlook.Attachments
Dim i As Long
Dim fso As Object

Const FOLDER_TO_SAVE As String = Environ("userprofile") & "\Desktop
\attachments\"

On Error Resume Next
Set MsgColl = ActiveExplorer.Selection
On Error GoTo 0

If MsgColl Is Nothing Then Goto ExitProc

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(FOLDER_TO_SAVE) = False Then
MkDir FOLDER_TO_SAVE
End If

If Not MsgColl Is Nothing Then
' we selected multiple items
For i = 1 To MsgColl.Count
' set an obj reference to each mail item so we can move it
Set Msg = MsgColl.Item(i)
Set MsgAttach = Msg.Attachments
With MsgAttach.Item(1)
.SaveAsFile FOLDER_TO_SAVE & .DisplayName
End With
Msg.Unread = False
Next i
Else
GoTo ExitProc
End If

ExitProc:
Set MsgAttach = Nothing
Set Msg = Nothing
Set MsgColl = Nothing
Set fso = Nothing
End Sub


--JP
 
Thanks for the reply JP this looks like just what I need.

Unfortunately I get a compile error on the line

Const FOLDER_TO_SAVE As String = Environ("userprofile") & "\Desktop
\attachments\"

saying constant expression required with the word Environ highlighte
 
Sorry my mistake, just add this to the declaration section:

Dim FOLDER_TO_SAVE As String

and change that line to:

FOLDER_TO_SAVE = Environ("userprofile") & "\Desktop\attachments\"


--JP
 
Back
Top