Downloading Outlook attachments from a separate mailbox

[Sherbalex]

Hi there,

First of all, a big thanks to everyone who posts answers on this forum as I use them quite a lot to help me out. This time, I haven't managed to find my answer in existing posts however...

I'm currently using Outlook 2003 trying to create some code that allows me to download all the attachments from a mailbox (not my default inbox) into a specified file path. There will be c. 900 attachments coming in each week.

Here is the code I'm using at the moment:

Public Sub GetAttachments()
' This Outlook macro checks the Outlook "~ COO Timesheets" Inbox for messages
' with attached files (any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
    Dim ns As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = Application.GetNamespace("MAPI")
    Set Inbox = ns.Folders("~ COO Timesheets").Folders("Inbox")
    i = 0
' Check Inbox for messages and exit if none found
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in ~ COO Timesheets.", 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 = "\\fs11edx\grpareas\pipeline\Project Support Office\P2P\UAT\Rob\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
' Show summary message - change the folder name as required
    If i > 0 Then
        MsgBox "I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the P2P folder." _
        & vbCrLf & vbCrLf & "Please confirm all files are there.", vbInformation, "Finished!"
    Else
        MsgBox "No files found 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

Hopefully that's enough info. Any help is much appreciated!

Rob

 

[Trevor G]

Welcome to the Forum,

Will this link help you?

http://stackoverflow.com/questions/...cel-file-from-an-outlook-email-that-was-insid