1

我正在尝试修改此 VBA 代码以将电子邮件中的所有附件保存在 Inboxsubfolder中。项目填充了此文件夹中的所有消息，但其余代码不起作用。

我正在尝试打印出要调试的项目对象，但这也不起作用。

原始代码：https ://community.spiceworks.com/scripts/show/361-auto-save-attachments-to-folder

更新 1：我现在意识到只有 Application_Startup() 可以使用 Run 按钮进行调试。发送一封测试电子邮件，我能够逐步完成该程序并看到一切都按预期工作。

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
4

1 回答 1

0

尝试设置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
于 2020-08-07T19:47:56.450 回答