Microsoft Office Tutorials and References
In Depth Information
Saving E-mail Attachments in a Specified Folder
'Create target directory object that is used for saving¶
'attachments¶
Set fld = fso.GetFolder(SelectFolder)¶
'Set objApp object¶
Set objApp = Outlook.Application¶
'Set source folder as the currently activated folder¶
Set objFolder = objApp.ActiveExplorer.CurrentFolder¶
'Confirmation¶
If MsgBox("Do you want to extract all attached items " & _¶
"in " & objFolder.Name & _¶
" and save into " & fld.path & " directory?", _¶
vbYesNo + vbQuestion, "Confirmation") = vbNo _¶
Then GoTo ErrHandler¶
'Explore all mail items in selected folder¶
For Each objItem In objFolder.Items¶
'If item is mail object then continue processing item¶
If objItem.Class = olMail Then¶
'Explore all attachments in email message¶
For Each itemAttc In objItem.Attachments¶
'Increase counter for attachment count¶
i = i + 1¶
'Retrieve file name and extension¶
'Calls ExplodeFileName custom function¶
strFileName = ExplodeFileName(itemAttc.FileName)¶
'Create new file name if the same file is already¶
'existing in folder¶
'Simply adds _X at the end of the file¶
'X is the incrementing number¶
strFileName = CreateFileName(strFileName, fso, fld)¶
'Finally save attachment as file by given path¶
itemAttc.SaveAsFile fld.path & "\" & _¶
strFileName(0) & strFileName(1)¶
Next itemAttc¶
End If¶
Next objItem¶
'Inform user about completion and saved number¶
'of attachment¶
MsgBox i & " attachments have been succesfully saved in " _¶
& fld.path¶
ExitSub:¶
'Release object variables and memory¶
Set fso = Nothing¶
Set objApp = Nothing¶
Exit Sub¶
Out
Search JabSto ::




Custom Search