none
Outlook 2010 - Save Attachment to Specific Folder on Disk Automatically

    Question

  • I have the following code:

     

    
    
    Sub Test()
    
    
    
    
    
    Dim arg1 As String
    
    Dim arg2 As String
    
    Dim arg3 As String
    
    
    
    arg1 = "Trekker"
    
    arg2 = "XLS"
    
    arg3 = "C:\Trekker"
    
    '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 arg1, arg2, arg3
    
    
    
    
    
    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
    
     Dim createtime As String
    
    
    
     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
    
        createtime = Format(Item.CreationTime, "d-mmm-yy") & " " & Format(Item.CreationTime, "HhNnSs AM/PM")
    
        FileName = DestFolder & Item.SenderName & " " & createtime & " " & 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
    
    
    
    
    
    
    
    It is created in outlook vba and I received it from http://www.rondebruin.nl/mail/folder2/saveatt.htm.
    
    It runs correctly, but it is not done automatically. I have to hit alt + f11 and then run the macro. How can I convert this to a script and automatically run when the rule is initiated?
    
    Thanks!
    Wednesday, March 23, 2011 7:51 PM

Answers

  • Unless you actually want to handle new items to Inbox you don't need NewMail() at all. If you want to handle that you are far better off with NewMailEx(), which doesn't miss items coming in as NewMail() does.

    Are you calling the Initialize_handler() method to initialize things? Call it either manually or from the Application_Startup() event handler or from some other method.


    Ken Slovak MVP - Outlook
    • Marked as answer by dbansal Thursday, March 24, 2011 6:32 PM
    Thursday, March 24, 2011 5:47 PM
  • Thanks!!! That worked perfect!! NewMail() stinks!!!

     

    this is my code now:

     

    Dim myOlApp As New Outlook.Application
    Public WithEvents myOlItems As Outlook.Items

    Public Sub Initialize_handler()
        Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Trekker").Items
    End Sub

    Private Sub myOlItems_ItemAdd(ByVal Item As Object)
     Call KastleReports
    End Sub


    Private Sub Application_Startup()
    Initialize_handler

    End Sub

     


    ddd
    • Marked as answer by dbansal Thursday, May 05, 2011 5:44 PM
    Thursday, March 24, 2011 6:31 PM

All replies

  • At which point do you want it to automatically run?

     

    You need to create a handler for the event you want to trigger the method call.

     

    Like say upon adding an attachment or sending the email.

    Wednesday, March 23, 2011 9:17 PM
  • Kit,

     

    Thanks for replying!!!.  I need to this macro run when I have an email arrive in the "Trekker" folder under my inbox.  I am new to Outlook scripting and event handling. Can you please provide an example.

     

    Thanks!!


    ddd
    Thursday, March 24, 2011 1:02 PM
  • Kit,

     

    I found out how to do event handling.  I have the handler:

    Private Sub Application_NewMail()
    Call Test
    End Sub

    However, this fires everytime an item arrives in my inbox.  How may I alter this so it only fires when an item arrives in a particular subfolder?

     

    Thanks again!


    ddd
    Thursday, March 24, 2011 1:27 PM
  • NewMail() and the more recent NewMailEx() do only run on additions to Inbox.

    Get the subfolder as a Folder or MAPIFolder, then get a reference to that folder's Items collection and set up an event handler for the ItemAdd() event for that Items collection. That would do the trick.


    Ken Slovak MVP - Outlook
    Thursday, March 24, 2011 1:42 PM
  • Ken,

     

    Thanks for your reply!

    So this is what my thisoutlooksession looks like now:

     However, it still does not fire... Do I have to put something in the application_newmail routine? or am i doing this wrong?

    Dim myOlApp As New Outlook.Application
    Public WithEvents myOlItems As Outlook.Items
    
    Public Sub Initialize_handler()
      Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Trekker")
    End Sub
    
    Private Sub myOlItems_ItemAdd(ByVal Item As Object)
     Call Test
    End Sub
        
    
    Private Sub Application_NewMail()
    
    End Sub
    
    

     


    ddd
    Thursday, March 24, 2011 3:51 PM
  • Unless you actually want to handle new items to Inbox you don't need NewMail() at all. If you want to handle that you are far better off with NewMailEx(), which doesn't miss items coming in as NewMail() does.

    Are you calling the Initialize_handler() method to initialize things? Call it either manually or from the Application_Startup() event handler or from some other method.


    Ken Slovak MVP - Outlook
    • Marked as answer by dbansal Thursday, March 24, 2011 6:32 PM
    Thursday, March 24, 2011 5:47 PM
  • Thanks!!! That worked perfect!! NewMail() stinks!!!

     

    this is my code now:

     

    Dim myOlApp As New Outlook.Application
    Public WithEvents myOlItems As Outlook.Items

    Public Sub Initialize_handler()
        Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Trekker").Items
    End Sub

    Private Sub myOlItems_ItemAdd(ByVal Item As Object)
     Call KastleReports
    End Sub


    Private Sub Application_Startup()
    Initialize_handler

    End Sub

     


    ddd
    • Marked as answer by dbansal Thursday, May 05, 2011 5:44 PM
    Thursday, March 24, 2011 6:31 PM
  • dbansal,

    can you please write all the code?

    THX

    Fedemrpink

    Thursday, May 05, 2011 1:02 PM
  • sorry!
    ddd
    Thursday, May 05, 2011 5:43 PM