使用Redemption.SafeMailItem无法发送邮件的问题排查

你的代码无法发送邮件的核心原因是Redemption.SafeMailItem未关联到你创建的Outlook.MailItem，另外RDOSession的使用也可以优化。

关键问题点 #

• 你创建了RDOSafeMail对象，但没有将配置好的OlMail绑定到它，导致Send方法没有可发送的邮件内容。
• RDOSesh.Logon的参数可以简化，当前写法虽然能运行，但不够清晰。

修复后的代码（基于原有逻辑） #

Sub UsingRDO()
'/*This script uses Redemption Com add in to send emails*/
Dim OlMail As Outlook.MailItem
Dim RDOSafeMail As Redemption.SafeMailItem
Dim AttachmentStr As String
Dim RDOSesh As Redemption.RDOSession

Set RDOSesh = New Redemption.RDOSession
Set OlMail = Outlook.Application.CreateItem(ItemType:=olMailItem)
Set RDOSafeMail = New Redemption.SafeMailItem
AttachmentStr = "C:\Users\Kennedy_Ngugi\Desktop\Faiba\"
       
' 使用当前Outlook配置文件登录，参数简化
RDOSesh.Logon
        
With OlMail
        .Body = "Hello" & vbCrLf & vbCrLf & "This is a Test Email"
        .BodyFormat = olFormatHTML
        .To = "somebody.someone@madhatter.co.ke"
        .CC = "somebody.someone@madhatter.co.ke"
        .Subject = "Internet Connectivity Test Email"
        .Attachments.Add AttachmentStr & "Kitchen Catalogue.png"
        .Attachments.Add AttachmentStr & "Sitting Room Catalogue.jpeg"
        .Attachments.Add AttachmentStr & "Madhatter COMPANY PROFILE.pdf"
        '.DeferredDeliveryTime = #8/1/2024 6:30:49 AM#
End With

' 关键步骤：将Outlook邮件对象绑定到SafeMailItem
Set RDOSafeMail.Item = OlMail
' 发送邮件
RDOSafeMail.Send

' 释放资源
Set RDOSafeMail = Nothing
Set OlMail = Nothing
RDOSesh.Logoff
Set RDOSesh = Nothing
End Sub

更简洁的纯Redemption写法（推荐） #

不需要依赖Outlook.MailItem，直接通过Redemption创建并发送邮件，逻辑更清晰：

Sub UsingPureRDO()
Dim RDOSesh As Redemption.RDOSession
Dim RDOMail As Redemption.RDOMail
Dim AttachmentStr As String

Set RDOSesh = New Redemption.RDOSession
RDOSesh.Logon ' 使用当前配置文件登录

Set RDOMail = RDOSesh.CreateItem(olMailItem)
AttachmentStr = "C:\Users\Kennedy_Ngugi\Desktop\Faiba\"

With RDOMail
        .Body = "Hello" & vbCrLf & vbCrLf & "This is a Test Email"
        .BodyFormat = olFormatHTML
        .To = "somebody.someone@madhatter.co.ke"
        .CC = "somebody.someone@madhatter.co.ke"
        .Subject = "Internet Connectivity Test Email"
        .Attachments.Add AttachmentStr & "Kitchen Catalogue.png"
        .Attachments.Add AttachmentStr & "Sitting Room Catalogue.jpeg"
        .Attachments.Add AttachmentStr & "Madhatter COMPANY PROFILE.pdf"
        '.DeferredDeliveryTime = #8/1/2024 6:30:49 AM#
        .Send ' 直接发送，无Outlook安全提示
End With

' 释放资源
Set RDOMail = Nothing
RDOSesh.Logoff
Set RDOSesh = Nothing
End Sub

额外注意事项 #

• 确保Redemption COM组件已正确注册（一般安装后自动注册）。
• 如果Outlook未运行，RDOSesh.Logon可能需要指定配置文件名，例如RDOSesh.Logon "Outlook Profile Name"。

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