此方法不能与内联响应邮件项目一起使用。无法发送任何电子邮件

Question

我使用 Outlook 365 VBA 创建了一个邮件合并工具。它创建电子邮件并为其指定类别并将其保存在草稿文件夹中。然后，我设置了一个子组件来发送具有该特定类别名称的电子邮件。

当我运行邮件合并来生成电子邮件时，所有电子邮件都没有 此方法不能与内联响应邮件项目一起使用的操作。

但是，当我运行子程序循环浏览草稿文件夹时，它找到的所有电子邮件都会在“监视”窗口中显示正确的主题标题、内容等，但现在对它们有上述消息的操作。这似乎阻止了电子邮件的发送。

有人知道为什么吗？或者如何清除Action？

这是发送子代码

    Sub SendEmailBatch()
    Dim Out_OutlookApp As outlook.Application
    Dim Out_MailItem As outlook.MailItem
    Dim Obj_SendingAccount As Object
    Dim Out_DeliveryFolder As outlook.Folder
    Dim Wrk_WsTable As Worksheet
    Dim Str_AccountName As String
    Dim Str_CategoryName As String
    
    ' Create a new instance of Outlook Application
    Set Out_OutlookApp = New outlook.Application
    
    ' Set reference to the worksheet
    Set Wrk_WsTable = ThisWorkbook.Sheets("Table")
    
    ' Get account name from the worksheet
    Str_AccountName = Wrk_WsTable.Range("G11").Value
    
    ' Get category name from the worksheet
    Str_CategoryName = Wrk_WsTable.Range("G36").Value
    
    ' Find the sending account
    For Each Obj_SendingAccount In Out_OutlookApp.Session.Accounts
        If Obj_SendingAccount.DisplayName = Str_AccountName Then
            Exit For
        End If
    Next Obj_SendingAccount
    
    ' If the sending account is not found among regular accounts, search among shared mailboxes
    If Obj_SendingAccount Is Nothing Then
        For Each Obj_SendingAccount In Out_OutlookApp.Session.Stores
            If Obj_SendingAccount.DisplayName = Str_AccountName Then
                Set Out_DeliveryFolder = Obj_SendingAccount.GetDefaultFolder(olFolderDrafts)
                Exit For
            End If
        Next Obj_SendingAccount
    End If
    
    ' Check if the sending account is found
    If Obj_SendingAccount Is Nothing Then
        MsgBox "Sending account not found.", vbExclamation
        Exit Sub
    End If
    
    ' Loop through the items in the drafts folder
    For Each Out_MailItem In Out_DeliveryFolder.Items
        ' Check if the email has the specified category
        If Out_MailItem.Categories = Str_CategoryName Then
            ' Clear conversation index to avoid it being marked as a response
            Out_MailItem.ClearConversationIndex
            ' Set DeferredDeliveryTime to a future time to prevent inline response status
            Out_MailItem.DeferredDeliveryTime = Now + TimeValue("00:01:00") ' Delay for 1 minute
            ' Send the email
            
            Out_MailItem.Send
        End If
    Next Out_MailItem
    
    MsgBox "Emails sent.", vbInformation
End Sub

我尝试让 ChatGPT 提供帮助，它建议使用 ClearConversationIndex 并添加延迟交付时间，但这并没有奏效。

Answer 1

如果内联响应编辑器中显示消息，Outlook 将不允许您对其调用

MailItem.Send

；无论您是从草稿文件夹（在发送之前一直存储在此处）还是从

Explorer.ActiveInlineResponse

访问它。

唯一的解决方法是使用辅助功能 API 调用“发送”按钮来查找“发送”按钮并模拟单击它。如果可以使用Redemption（我是它的作者），您可以使用SafeExplorer。

ActiveInlineResponseSend

方法。

在 VBA 中：

set sExplorer = CreateObject("Redemption.SafeExplorer")
sExplorer.Item = Application.ActiveExplorer
sExplorer.ActiveInlineResponseSend