Сценарий Outlook VBA для сохранения всех вложений во вложенной папке "Входящие"

Question

Я пытаюсь изменить этот код VBA, чтобы сохранить все вложения из писем в папке "Входящие". subfolder. Items заполняется всеми сообщениями в этой папке, но остальной код не работает.

Я пытаюсь распечатать объект элемента для отладки, но это тоже не работает.

Исходный код: https://community.spiceworks.com/scripts/show/361-auto-save-attachments-to-folder

Обновление 1: теперь я понял, что только Application_Startup() можно отлаживать с помощью кнопки "Выполнить". Отправив тестовое электронное письмо, я смог пройти через программу и убедиться, что все работает, как ожидалось.

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 = "[e-mail]") 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

Answer 1

Попробуйте настроить свой Application_Startup как следующее

пример

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