Outlook新建邮件自动添加附件的VBA脚本问题求助

问题原因 #

你修改后的脚本出现双窗口，是因为在NewInspector事件中调用Application.CreateItem(olMailItem)重新创建了一个邮件实例，叠加了点击新建按钮生成的原始空白邮件，导致两个窗口同时打开。

修正后的代码 #

直接对触发事件的当前邮件项添加附件，无需新建邮件：

Private WithEvents objInspectors As Outlook.Inspectors

Private Sub Application_Startup()
    Set objInspectors = Application.Inspectors
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    Dim myItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
    
    ' 验证当前项为邮件，且是新建未保存的邮件（EntryID为空）
    If TypeName(Inspector.CurrentItem) = "MailItem" Then
        Set myItem = Inspector.CurrentItem
        If myItem.EntryID = "" Then
            ' 为当前新建邮件添加附件
            Set myAttachments = myItem.Attachments
            myAttachments.Add "C:\attachment.docx", olByValue, 1, "Test"
            MsgBox "已自动添加附件" ' 可选：不需要提示可删除此行
        End If
    End If
End Sub

关键说明 #

• 避免重复创建邮件：直接使用Inspector.CurrentItem获取当前打开的新建邮件，而非调用CreateItem生成新邮件。
• 限定触发范围：通过EntryID = ""判断邮件是新建未保存状态，避免给回复、转发的邮件也自动添加附件。
• 路径验证：确保C:\attachment.docx文件存在，否则会触发运行时错误。
• 生效方式：保存脚本后重启Outlook，Application_Startup会在启动时初始化监听器。

内容的提问来源于stack exchange，提问作者Paul