Re: Amend this Code-pls

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance


After the 'For Each Item...' line you can check the Item's
SenderEMailAddress property and set the FileName depending on that address.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Quick-Cats - Categorize Outlook data:
<http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6>


Am Sat, 9 Jun 2007 09:59:02 -0700 schrieb mrbalaje:

Hello,

I have the following code, which actually download the attachements to a
folder when I run the macro.

But what I actually need is, attachements in mails from different person
should be saved in different folder.

For example: Mail for Person "X", attachement in that mail to save in
folder
"X"

And I want that macro to run automatically when a new mail hit the inbox.

Here is the code I use:

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
Set Ns = GetNamespace("MAPI")
Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
i = 0
' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In Inbox.Items
' Save any attachments found
For Each Atmt In Item.Attachments
' This path must exist! Change folder name as necessary.
FileName = "C:\Email Attachments\" & 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:\Email Attachments
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
.

Relevant Pages

  • Re: Proof Of Looping Bug in Reading Outlook Inbox From Access?
    ... Read through the Outlook Inbox from another program such as Microsoft ... Dim OlApp As Outlook.Application ... Dim intCountedLoops As Integer 'Only Necessary For Logic Check ... Set SavedMailItems = Mailobject.Move ...
    (microsoft.public.outlook.program_vba)
  • Re: Proof Of Looping Bug in Reading Outlook Inbox From Access?
    ... Outlook Inbox and moves the mail from the Inbox to one of two folders: ... Dim OlApp As Outlook.Application ... Dim intCountedLoops As Integer ... Set SavedMailItems = Mailobject.Move ...
    (microsoft.public.outlook.program_vba)
  • RE: Saving outlook attachments with VBA code
    ... The problem is the inbox I am trying to save the attached files from. ... Dim olApp As Outlook.Application ... closebook = MsgBox("Process Complete. ... "Jacob Skaria" wrote: ...
    (microsoft.public.excel.programming)
  • Amend this Code-pls
    ... But what I actually need is, attachements in mails from different person ... should be saved in different folder. ... And I want that macro to run automatically when a new mail hit the inbox. ... Dim Inbox As MAPIFolder ...
    (microsoft.public.outlook.program_vba)
  • Blank Mail
    ... If i try to move my mail from inbox to my persional folder all the data gets ... bland only i am able to view the attachements the boyd of the mail will ...
    (microsoft.public.outlook)