Outlook VBA脚本,用于保存收件箱子文件夹中的所有附件

Outlook VBA脚本,用于保存收件箱子文件夹中的所有附件,vba,outlook,vba7,vba6,Vba,Outlook,Vba7,Vba6,我正在尝试修改此VBA代码,以将电子邮件中的所有附件保存在收件箱子文件夹中。Items使用此文件夹中的所有邮件填充,但其余代码不起作用 我试图打印出要调试的item对象,但这也不起作用 原始代码: 更新1: 我现在意识到只有应用程序_Startup()可以通过使用Run按钮进行调试。通过发送一封测试电子邮件,我能够逐步完成程序,并看到一切都按预期进行 Option Explicit Public WithEvents Items As Outlook.Items Public Sub Appli

我正在尝试修改此VBA代码,以将电子邮件中的所有附件保存在收件箱
子文件夹中。Items使用此文件夹中的所有邮件填充,但其余代码不起作用

我试图打印出要调试的item对象,但这也不起作用

原始代码:

更新1: 我现在意识到只有应用程序_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
请尝试按如下方式设置
应用程序\u启动

范例

请尝试按如下方式设置
应用程序\u启动

范例


“不工作”是什么意思?您试图调试这个问题的原因是什么?您之前已经发布了这个问题()并且有一些回复。您可以编辑原始帖子,而不是删除它(从而删除所有评论)。@NicoHaase是的,正如我所说,我可以在应用程序启动()中打印items对象函数,但我无法打印代码中包含的Else语句中的项。@DmitryStreblechenko很抱歉删除了它,我只是不小心用错误的标记发布了它。我看到您建议删除错误异常。我尝试过使用一个简单的print语句Debug.print(“test”),但它不打印任何内容。这个print语句在Application_Startup()函数中起作用,但“不起作用”是什么意思?您试图调试这个问题的原因是什么?您之前已经发布了这个问题()并且有一些回复。您可以编辑原始帖子,而不是删除它(从而删除所有评论)。@NicoHaase是的,正如我所说,我可以在应用程序启动()中打印items对象函数,但我无法打印代码中包含的Else语句中的项。@DmitryStreblechenko很抱歉删除了它,我只是不小心用错误的标记发布了它。我看到您建议删除错误异常。我尝试过使用一个简单的print语句Debug.print(“test”),但它不打印任何内容。这个print语句在Application_Startup()函数中工作,尽管我必须将函数更改为公共函数,否则无法手动运行它们。这不会产生任何输出,但我该如何调试/测试它?我只能使用vba编辑器在即时窗口中打印输出,我使用CTRL+打开该编辑器G@Austin确保代码位于单击应用程序启动()的“ThisOutlookSession”下
然后单击运行-然后将电子邮件发送给您自己,或在查看即时窗口时将电子邮件移动到sub_文件夹当功能设置为公共时,无法使用运行按钮选择这些功能。我用一封测试邮件进行了测试,但它不起作用。该脚本是否也可以在文件夹中的所有现有邮件上运行?@0m3r正如我之前所说的,即使我发送了一封主题为“已完成:”的测试电子邮件,修改了发件人的脚本,并且电子邮件有附件,该脚本也无法运行。我必须将功能更改为公共功能,否则无法手动运行它们。这不会产生任何输出,但我该如何调试/测试它?我只能使用vba编辑器在即时窗口中打印输出,我使用CTRL+打开该编辑器G@Austin确保代码位于单击应用程序启动()的“ThisOutlookSession”下然后单击运行-然后将电子邮件发送给您自己,或在查看即时窗口时将电子邮件移动到sub_文件夹当功能设置为公共时,无法使用运行按钮选择这些功能。我用一封测试邮件进行了测试,但它不起作用。此外,此脚本是否也可以在文件夹中的所有现有邮件上运行?@0m3r正如我之前所说的,即使我发送了一封主题为“已完成:”的测试电子邮件,修改了发件人的脚本,并且电子邮件有附件,此脚本也无法工作。
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