Outlook VBA script to save all attachments in an Inbox subfolder

Question

I am trying to modify this VBA code to save all attachments from emails in an Inbox subfolder. Items populates with all the messages in this folder but the rest of the code is not working.

I am trying to print out the item object to debug and that isn't working either.

Original code: https://community.spiceworks.com/scripts/show/361-auto-save-attachments-to-folder

Update 1: I realized now only Application_Startup() can be debugged by using the Run button. Sending a test email I was able to step through the program and see everything is working as expected.

Option Explicit
Public WithEvents Items As Outlook.Items
Public Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    
    Dim Sub_folder  As Outlook.MAPIFolder
    Set Sub_folder = Inbox.Folders("DocuSign")
    
    Set Items = Sub_folder.Items
End Sub


Public Sub Items_ItemAdd(ByVal Item As Object)
    Stop
    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject
    End If

On Error GoTo ErrorHandler
    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(Item) = "MailItem" Then
        Set Msg = Item
    'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.SenderEmailAddress = "test@email.com") And _
        (InStr(Msg.Subject, "Completed:")) And _
        (Msg.Attachments.Count >= 1) Then
        
    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim Att As String
        
    'location to save in.  Can be root drive or mapped network drive.
    Const attPath As String = "C:\Users\Austin\Desktop\temp\"
       
    ' save attachment
   Set myAttachments = Item.Attachments
    Att = myAttachments.Item(1).DisplayName
    ' remove .pdf
    Att = Left(Att, InStrRev(Att, ".") - 1)
    myAttachments.Item(1).SaveAsFile attPath & Att & "_signed.pdf"
        
    ' mark as read
   Msg.UnRead = False
End If
End If
    

ProgramExit:
  Exit Sub
  
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

What do you mean by "not working"? What have you tried to debug the problem? — Nico Haase, Aug 07 '20 at 16:08
You have already posted this question before (https://stackoverflow.com/questions/63292552/outlook-vba-to-save-all-attachments-in-an-inbox-subfolder) and there were a few replies. Rather than deleting it (and thus wiping out all comments), you can edit your original post. — Dmitry Streblechenko, Aug 07 '20 at 16:50
@NicoHaase Yes as I said I was able to print the items object in the Application_Startup() function but I am not able to print the items in the Else statement included in the code. — Austin, Aug 07 '20 at 17:04
@DmitryStreblechenko I apologize for deleting it I just accidentally posted with the wrong tags. I see you suggested removing the error exception. I have tried and just using a simple print statement Debug.Print ("test") but it doesn't print anything. This print statement works in the Application_Startup() function though — Austin, Aug 07 '20 at 17:22

score 0 · Answer 1 · answered Aug 07 '20 at 19:47

0

Try setting up your Application_Startup like the following

Example

Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    
    Dim Sub_folder  As Outlook.MAPIFolder
    Set Sub_folder = Inbox.Folders("DocuSign")
    
    Set Items = Sub_folder.Items
End Sub


Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject
    End If
End Sub

answered Aug 07 '20 at 19:47

0m3r

12,286
15
35
71

I do have to change the functions to be Public otherwise I can't run them manually. This is not producing any output though – Austin Aug 07 '20 at 20:10
Then how do I debug/test it? I can only print output in the Immediate Window using vba editor which I open with CTRL + G – Austin Aug 07 '20 at 20:45
@Austin make sure code is under `ThisOutlookSession` the click on `application_Startup()` then click run- after that send email to your self or move email to sub_folder while looking the immediate window – 0m3r Aug 07 '20 at 21:29
When the functions are set to public they cannot be selected with the run button. I tested regardless with a test email and it doesn't work. Also is it possible for this script to also run on all the existing mail in the folder? – Austin Aug 07 '20 at 22:41
@0m3r as I said before the script doesn't work even when I send a test email with subject "Completed:", modified script for the sender, and the email has an attachment. – Austin Aug 10 '20 at 17:40
@Austin lets forget about the script, can you tell me what are trying to do? are trying to download attachment from specific email address? – 0m3r Aug 10 '20 at 17:45
@0m3r Download attachment from specific email address with subject that includes the string "Completed:" – Austin Aug 11 '20 at 15:19
@0m3r I'm able to debug and print out variables in the Application_Startup() function if I change all the functions to public and run manually, but not in any other parts of the code – Austin Aug 11 '20 at 15:27
@0m3r Thank you for the help I was able to get it working – Austin Aug 11 '20 at 18:13
@0m3r It seems the script is not starting automatically when outlook starts. I have to run it once manually in the VBA development window. See here: https://stackoverflow.com/questions/63404746/why-is-my-script-not-running-automatically-when-outlook-is-started?noredirect=1#comment112116268_63404746 – Austin Aug 20 '20 at 22:12
@Austin is your macro security settings okay? – 0m3r Aug 23 '20 at 02:07
@0m3r Yes it is set to enable all macros – Austin Sep 01 '20 at 16:21

Outlook VBA script to save all attachments in an Inbox subfolder

1 Answers1