VB and VBA Users Source Code: Save Outlook mail attachments from the Inbox to a directory
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Save Outlook mail attachments from the Inbox to a directory
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, January 15, 2001
Hits:
1087
Category:
Internet/Remote Comms
Article:
The following code saves all the attachments from your inbox to a specifed path. 'Purpose : Saves all the attachments in your Outlook inbox to a specified directory 'Inputs : sSaveToPath The path to save the attachments to. 'Outputs : Returns Error description if an error occurrs 'Author : Andrew Baker 'Date : 04/01/2001 17:03 'Notes : 'Revisions : 'Assumptions : Function OutlookSaveAttachments(ByVal sSaveToPath As String) As String Dim oOutlook As Object 'For Early Bound use Outlook.Application Dim oNameSpace As Object 'For Early Bound use Outlook.NameSpace Dim oInBox As Object 'For Early Bound use Outlook.MAPIFolder Dim oMailItem As Object 'For Early Bound use Outlook.MailItem Dim sMessage As String, lThisAttach As Long On Error GoTo ErrNoOutlook Set oOutlook = CreateObject("Outlook.Application") Set oNameSpace = oOutlook.GetNamespace("MAPI") Set oInBox = oNameSpace.GetDefaultFolder(6) If Right$(sSaveToPath, 1) <> "\" Then sSaveToPath = sSaveToPath & "\" End If On Error Resume Next For Each oMailItem In oInBox.Items With oMailItem For lThisAttach = 1 To oMailItem.Attachments.Count If Len(Dir$(sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName)) Then 'Delete the existing file Kill sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName End If oMailItem.Attachments.Item(lThisAttach).SaveAsFile sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName Next End With Next Set oMailItem = Nothing Set oInBox = Nothing Set oNameSpace = Nothing Set oOutlook = Nothing Exit Function ErrNoOutlook: OutlookSaveAttachments = Err.Description On Error GoTo 0 'Clear error object End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
