Re: Get Attachments

With the Dir function you can check if a filename already exists before
saving the attachment.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


Am Mon, 11 Dec 2006 10:50:01 -0800 schrieb Nate Baker:

> I have a macro that saves all attachments from a specified Inbox folder to
a
> specified folder on my hard drive. It has a counter that tells me how many
> attachments it found and copied. I've found that it is overwriting the
copied
> attachments on the hard drive when the attachment file name is already
there
> (duplicated). This is fine, but, how do I have it count and display the
> duplicates (or number of overwrites)? This is what I have:
>
>
> Sub GetAttachments()
> ' This Outlook macro checks a the Outlook Inbox for messages
> ' with attached files (of any type) and saves them to disk.
> ' NOTE: make sure the specified save folder exists before
> ' running the macro.
> On Error GoTo GetAttachments_err
> ' Declare variables
> Dim ns As NameSpace
> Dim Inbox As MAPIFolder
> Dim Item As Object
> Dim Atmt As Attachment
> Dim FileName As String
> Dim i As Integer
> Dim SubFolder As MAPIFolder
> Set ns = GetNamespace("MAPI")
> Set Inbox = ns.GetDefaultFolder(olFolderInbox)
> Set SubFolder = Inbox.Folders("NYC")
> i = 0
> ' Check Inbox for messages and exit if none found
> If SubFolder.Items.Count = 0 Then
> MsgBox "There are no messages in the SubFolder.", vbInformation, _
> "Nothing Found"
> Exit Sub
> End If
> ' Check each message for attachments
> For Each Item In SubFolder.Items
> ' Save any attachments found
> For Each Atmt In Item.Attachments
> ' This path must exist! Change folder name as necessary.
> FileName = "C:\NYC\" & Atmt.FileName
> Atmt.SaveAsFile FileName
> i = i + 1
> Next Atmt
> Next Item
> ' Show summary message
> If i > 0 Then
> MsgBox "I found " & i & " attached files." _
> & vbCrLf & "I have saved them into the C:\NYC folder." _
> & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
> Else
> MsgBox "I didn't find any attached files in your mail.",
> vbInformation, "Finished!"
> End If
> ' Clear memory
> GetAttachments_exit:
> Set Atmt = Nothing
> Set Item = Nothing
> Set ns = Nothing
> Exit Sub
> ' Handle errors
> GetAttachments_err:
> MsgBox "An unexpected error has occurred." _
> & vbCrLf & "Please note and report the following information." _
> & vbCrLf & "Macro Name: GetAttachments" _
> & vbCrLf & "Error Number: " & Err.Number _
> & vbCrLf & "Error Description: " & Err.Description _
> , vbCritical, "Error!"
> Resume GetAttachments_exit
> End Sub