如何通过Outlook VBA重新发送ReportItem类型的退信？

ReportItem对象本身确实没有Send方法，直接执行SendAgain后生成的对象仍会保留ReportItem类型，导致无法调用Send。以下是两种可行的解决方案：

方案一：通过命令栏触发GUI发送操作 #

利用Outlook命令栏的ExecuteMso方法，直接触发"发送"按钮的点击操作，绕开对象类型限制：

Dim objApp As Outlook.Application
Dim objNameSpace As NameSpace
Dim journalAlertInbox As Folder
Dim objInspector As Inspector
Dim resendInspector As Inspector

Set objApp = CreateObject("Outlook.Application")
Set objNameSpace = objApp.GetNamespace("MAPI")
Set journalAlertInbox = objNameSpace.Stores.Item("thestore").GetDefaultFolder(olFolderInbox)

For Each folderItem In journalAlertInbox.Items
    If TypeOf folderItem Is ReportItem Then
        folderItem.Display
        Set objInspector = folderItem.GetInspector
        ' 执行"再次发送"命令
        objInspector.CommandBars.ExecuteMso "SendAgain"
        
        ' 获取新打开的重发邮件窗口
        Set resendInspector = objApp.ActiveInspector
        ' 触发"发送"命令
        resendInspector.CommandBars.ExecuteMso "Send"
        
        ' 关闭原退信窗口（不保存）
        folderItem.Close olDiscard
        ' 关闭发送后的窗口
        resendInspector.CurrentItem.Close olDiscard
    End If
Next folderItem

注意：该方法依赖Outlook的界面命令，需确保Outlook窗口处于可交互状态，不同Outlook版本的命令ID需保持一致（"SendAgain"和"Send"是通用命令ID）。

方案二：手动构造MailItem发送（更稳定） #

直接从ReportItem中提取关键信息，新建标准的MailItem对象，调用其Send方法发送，完全脱离GUI依赖：

Dim objApp As Outlook.Application
Dim objNameSpace As NameSpace
Dim journalAlertInbox As Folder
Dim reportItem As ReportItem
Dim newMail As MailItem

Set objApp = CreateObject("Outlook.Application")
Set objNameSpace = objApp.GetNamespace("MAPI")
Set journalAlertInbox = objNameSpace.Stores.Item("thestore").GetDefaultFolder(olFolderInbox)

For Each folderItem In journalAlertInbox.Items
    If TypeOf folderItem Is ReportItem Then
        Set reportItem = folderItem
        ' 创建新邮件
        Set newMail = objApp.CreateItem(olMailItem)
        
        ' 填充邮件信息（根据实际需求调整）
        newMail.To = reportItem.To  ' 退信的To通常是原邮件发件人，可按需修改
        newMail.Subject = "重发: " & reportItem.Subject
        newMail.Body = "重发原始退信内容:" & vbCrLf & reportItem.Body
        
        ' 复制原退信的附件
        Dim att As Attachment
        For Each att In reportItem.Attachments
            att.CopyTo newMail.Attachments, olAttachmentPositionEnd
        Next att
        
        ' 直接发送
        newMail.Send
        
        ' 可选：将原退信移动到已处理文件夹
        ' reportItem.Move objNameSpace.GetDefaultFolder(olFolderArchive)
    End If
Next folderItem

该方案更可靠，不受界面状态影响，但需要手动处理邮件内容、格式、附件等细节，可根据实际业务需求调整信息填充逻辑。

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