+ Reply to Thread
Results 1 to 9 of 9

Outlook code - save attachments

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    01-30-2011
    Location
    Vancouver, Canada
    MS-Off Ver
    Excel 2010
    Posts
    604

    Outlook code - save attachments

    I'm trying to get this code running but I'm unsure where you declare Arg 1, Arg 2 and Arg 3? What do I have to change to Ron's code to make it work?


    http://www.rondebruin.nl/mail/folder2/saveatt.htm


    Sub Test()
    'Arg 1 = Folder name in your Inbox
    'Arg 2 = File extension, "" is every file
    'Arg 3 = Save folder, "C:\Users\Ron\test" or ""
    'If you use "" it will create a date/time stamped
    'folder for you in the "My Documents" folder.
    'Note: If you use this "C:\Users\Ron\test" the folder must exist
    
        SaveEmailAttachmentsToFolder "MyFolder", "xls", ""
    
    End Sub
    Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                                     ExtString As String, DestFolder As String)
        Dim ns As Namespace
        Dim Inbox As MAPIFolder
        Dim SubFolder As MAPIFolder
        Dim Item As Object
        Dim Atmt As Attachment
        Dim FileName As String
        Dim MyDocPath As String
        Dim I As Integer
        Dim wsh As Object
        Dim fs As Object
    
        On Error GoTo ThisMacro_err
    
        Set ns = GetNamespace("MAPI")
        Set Inbox = ns.GetDefaultFolder(olFolderInbox)
        Set SubFolder = Inbox.Folders(OutlookFolderInInbox)
    
        I = 0
        ' Check subfolder for messages and exit of none found
        If SubFolder.Items.Count = 0 Then
            MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _
                   vbInformation, "Nothing Found"
            Set SubFolder = Nothing
            Set Inbox = Nothing
            Set ns = Nothing
            Exit Sub
        End If
    
        'Create DestFolder if DestFolder = ""
        If DestFolder = "" Then
            Set wsh = CreateObject("WScript.Shell")
            Set fs = CreateObject("Scripting.FileSystemObject")
            MyDocPath = wsh.SpecialFolders.Item("mydocuments")
            DestFolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss")
            If Not fs.FolderExists(DestFolder) Then
                fs.CreateFolder DestFolder
            End If
        End If
    
        If Right(DestFolder, 1) <> "\" Then
            DestFolder = DestFolder & "\"
        End If
    
        ' Check each message for attachments and extensions
        For Each Item In SubFolder.Items
            For Each Atmt In Item.Attachments
                If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                    FileName = DestFolder & Item.SenderName & " " & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    I = I + 1
                End If
            Next Atmt
        Next Item
    
        ' Show this message when Finished
        If I > 0 Then
            MsgBox "You can find the files here : " _
                 & DestFolder, vbInformation, "Finished!"
        Else
            MsgBox "No attached files in your mail.", vbInformation, "Finished!"
        End If
    
        ' Clear memory
    ThisMacro_exit:
        Set SubFolder = Nothing
        Set Inbox = Nothing
        Set ns = Nothing
        Set fs = Nothing
        Set wsh = Nothing
        Exit Sub
    
        ' Error information
    ThisMacro_err:
        MsgBox "An unexpected error has occurred." _
             & vbCrLf & "Please note and report the following information." _
             & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
             & vbCrLf & "Error Number: " & Err.Number _
             & vbCrLf & "Error Description: " & Err.Description _
             , vbCritical, "Error!"
        Resume ThisMacro_exit
    
    End Sub

  2. #2
    Forum Guru MarvinP's Avatar
    Join Date
    07-23-2010
    Location
    Woodinville, WA
    MS-Off Ver
    Office 365
    Posts
    16,227

    Re: Outlook code - save attachments

    Hi Xx7,

    I see you are having an argument with the arguments

    It looks like you need to call the subroutine
    SaveEmailAttachmentsToFolder
    followed by stuff. This stuff is called Arguments.

    To be more specific the
    SaveEmailAttachmentsToFolder
    says you need to have 3 strings in the call like this:

    SaveEmailAttachmentsToFolder (String1, String2, Sting3)
    The Strings are called Arguments to be passed to the subroutine.

    More specifically String1 needs to be.... read the code..

    So you would use this subroutine like:
    Call SaveEmailAttachmentsToFolder ("Sent Items", "pdf", "C:\Users\Ron\test" )

    Hope this helps.
    Last edited by MarvinP; 04-10-2011 at 01:52 PM. Reason: Added Code Tags
    One test is worth a thousand opinions.
    Click the * Add Reputation below to say thanks.

  3. #3
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,259

    Re: Outlook code - save attachments

    Hello MarvinP,

    Please use code tags even around code fragments for better readability.
    Sincerely,
    Leith Ross

    Remember To Do the Following....

    1. Use code tags. Place [CODE] before the first line of code and [/CODE] after the last line of code.
    2. Thank those who have helped you by clicking the Star below the post.
    3. Please mark your post [SOLVED] if it has been answered satisfactorily.


    Old Scottish Proverb...
    Luathaid gu deanamh maille! (Rushing causes delays!)

  4. #4
    Forum Contributor
    Join Date
    01-30-2011
    Location
    Vancouver, Canada
    MS-Off Ver
    Excel 2010
    Posts
    604

    Re: Outlook code - save attachments

    So, do I leave the code above the same and then insert a new sub procedure?

    Sub testing1()
    Call SaveEmailAttachmentsToFolder("MyFolder", "pdf", "C:\Users\BD\Desktop\Attachments")
    End Sub
    I get an error saying "The attempted operation failed. An object could not be found"

  5. #5
    Forum Guru MarvinP's Avatar
    Join Date
    07-23-2010
    Location
    Woodinville, WA
    MS-Off Ver
    Office 365
    Posts
    16,227

    Re: Outlook code - save attachments

    I would assume that one of the Arguments is not valid.

    Do you have Outlook running and open on your computer? Does the Inbox agree with what you are passing to the Sub? Does the "pdf" need a period in front of it like ".pdf"? Read the code and see what is needed exactly. All these may need to agree, based on how the sub is written.

    You should set breakpoints and step through the code to see where it fails. see http://www.cpearson.com/excel/Debug.htm

  6. #6
    Forum Contributor
    Join Date
    01-30-2011
    Location
    Vancouver, Canada
    MS-Off Ver
    Excel 2010
    Posts
    604

    Re: Outlook code - save attachments

    If I have the 2 subs in my initial post. Don't I only have to run the "test" sub to get the macro to work? Do I change the code in the "test" sub or are you saying that I need a 3rd separate sub where I use something like:

    Sub testing1()
    Call SaveEmailAttachmentsToFolder("MyFolder", "pdf", "C:\Users\BD\Desktop\Attachments")
    End Sub

  7. #7
    Forum Expert
    Join Date
    12-23-2006
    Location
    germany
    MS-Off Ver
    XL2003 / 2007 / 2010
    Posts
    6,326

    Re: Outlook code - save attachments

    Is there a particular reason why an Outlook question is posted in an XL forum?

  8. #8
    Forum Contributor
    Join Date
    01-30-2011
    Location
    Vancouver, Canada
    MS-Off Ver
    Excel 2010
    Posts
    604

    Re: Outlook code - save attachments

    Quote Originally Posted by arthurbr View Post
    Is there a particular reason why an Outlook question is posted in an XL forum?
    My fault... I didn't even consider that. just assumed everything from Ron de Bruins site was all excel related.

  9. #9
    Forum Expert
    Join Date
    12-23-2006
    Location
    germany
    MS-Off Ver
    XL2003 / 2007 / 2010
    Posts
    6,326

    Re: Outlook code - save attachments

    OK
    I moved the thread to the appropriate forum

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1