如何通过VBA在Outlook中打开插入项目对话框

你要调出的这个对话框是Outlook内置的选择项目对话框，可通过以下VBA代码实现，核心是利用GetSelectNamesDialog并调整参数来适配邮件选择需求：

核心实现步骤 #

• 创建选择对话框实例，修改默认显示模式为文件夹项目选择
• 指定可选的文件夹（如收件箱、已发送邮件箱）
• 限制选择类型为邮件，支持多选
• 将选中的邮件添加为新邮件的附件

完整VBA代码示例 #

Sub AttachExistingEmailsToNewMessage()
    Dim selectDialog As SelectNamesDialog
    Dim targetFolder As Folder
    Dim selectedMail As MailItem
    Dim newMessage As MailItem
    Dim selectedItems As Items
    
    ' 创建新邮件
    Set newMessage = Application.CreateItem(olMailItem)
    
    ' 初始化选择对话框
    Set selectDialog = Application.Session.GetSelectNamesDialog()
    selectDialog.Caption = "选择要附加的邮件"
    
    ' 设置对话框为文件夹项目选择模式
    selectDialog.SetDefaultDisplayMode olDefaultDisplayModeFolder
    
    ' 指定默认选择文件夹（这里用收件箱，可改为olFolderSentMail等）
    Set targetFolder = Application.Session.GetDefaultFolder(olFolderInbox)
    selectDialog.InitialFolder = targetFolder
    
    ' 允许多选邮件
    selectDialog.AllowMultipleSelection = True
    
    ' 显示对话框，用户确认后执行后续操作
    If selectDialog.Display Then
        ' 获取选中的邮件集合
        Set selectedItems = targetFolder.Items.Restrict("[EntryID] = '" & selectDialog.Recipients(1).EntryID & "'")
        
        ' 遍历选中邮件，添加为附件
        For Each selectedMail In selectedItems
            ' olEmbeddeditem为嵌入附件，olByValue为普通邮件图标附件
            newMessage.Attachments.Add selectedMail, olEmbeddeditem
        Next selectedMail
        
        ' 展示新邮件
        newMessage.Display
    End If
    
    ' 释放对象
    Set selectDialog = Nothing
    Set targetFolder = Nothing
    Set selectedMail = Nothing
    Set newMessage = Nothing
End Sub

补充说明 #

• 若要切换可选文件夹，修改GetDefaultFolder的参数即可，比如olFolderSentMail对应已发送邮件箱，olFolderDrafts对应草稿箱
• 若需要筛选特定邮件（如未读、特定主题），可在Restrict方法中添加条件，示例："[UnRead] = True AND [Subject] LIKE '%项目汇报%'"

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