Question

今天早上，这使我发疯。基本上，我试图编写一个宏来“全部答复”，向主题添加文本，添加收件人，并删除收件人。

Sub Reply_All()
    Dim olReply As mailitem
    Dim strSubject As String
    For Each olItem In Application.ActiveExplorer.Selection
    Set olReply = olItem.ReplyAll
    Set olRecip = olReply.Recipients.Add("EmailAddressGoesHere")
    Set olRecip = olReply.Recipients.Remove("EmailAddressGoesHere")
    strSubject = olReply.Subject
        olReply.Subject = "(Added Subject Line Info - ) " & strSubject
        olReply.Display
    Next
End Sub

当我注释掉“收件人。删除”行时，一切都正常。

在过去的几个小时里，我一直在疯狂地谷歌搜索，但我不知道如何使它正常工作。

我注意到了

Set olRecip = olReply.Recipients.Add("EmailAddressGoesHere")

具有“将名称添加为字符串”

而

Set olRecip = olReply.Recipients.Remove("EmailAddressGoesHere")

具有“删除索引已久”作为在脚本中键入它时出现的黄色文本。

我觉得肯定有一个非常简单的解决方案，我暂时还没有想到。

Answer 1

使用“计数”到1的“ for”循环遍历收件人，检查Recipient.Address属性。如果它与您要的值匹配，请调用Recipients.Remove并传递当前循环索引。

Answer 2

正如德米特里（Dmitry）所述，您可以参考以下代码：

    Sub Reply_All()
    Dim olReply As MailItem
    Dim strSubject As String
    For Each olItem In Application.ActiveExplorer.Selection
    Set olReply = olItem.ReplyAll
    For Each Address In EmailAddressGoesHere
    olReply.Recipients.Add (Address)
    Next
    For Each Rec In olReply.Recipients
        Rec.Delete
    Next
    strSubject = olReply.Subject
        olReply.Subject = "(Added Subject Line Info - ) " & strSubject
        olReply.Display
    Next
    End Sub

有关更多信息，请参考此链接：

remove recipient from mail.recipient collection

Answer 3

Option Explicit
' Consider Option Explicit mandatory
' Tools | Options | Editor tab | Require Variable Declaration

Sub Reply_All_RemoveSingleOrMultipleCopiesAddress()

    Dim olItem As Object
    Dim olReply As MailItem

    Dim i As Long

    For Each olItem In ActiveExplorer.Selection

        If olItem.Class = olMail Then

            Set olReply = olItem.ReplyAll

            'olReply.Display

            ' If the address could occur once or multiple times,
            '  start at the end and work backwards
            For i = olReply.Recipients.count To 1 Step -1

                'Debug.Print olReply.Recipients(i).Address

                ' "EmailAddressToBeRemoved" with the quotes as shown
                If LCase(olReply.Recipients(i).Address) = LCase("EmailAddressToBeRemoved") Then
                    olReply.Recipients.remove (i)
                End If

            Next

            olReply.Display

        End If

    Next

End Sub


Sub Reply_All_RemoveSingleAddressReliably()

    Dim olItem As Object
    Dim olReply As MailItem
    Dim recip As recipient

    For Each olItem In ActiveExplorer.Selection

        If olItem.Class = olMail Then

            Set olReply = olItem.ReplyAll

            'olReply.Display

            ' If the address can appear once only,
            '  otherwise use a downward counting loop
            For Each recip In olReply.Recipients

                'Debug.Print recip.Address

                ' "EmailAddressToBeRemoved" with the quotes as shown 
                If LCase(recip.Address) = LCase("EmailAddressToBeRemoved") Then

                    ' Delete not remove
                    recip.Delete

                    ' No need to continue if only one instance of address can occur,
                    '  otherwise you would unreliably delete anyway.
                    ' The address immediately after a deleted address is skipped
                    '  as it moves into the old position of the deleted address.
                    Exit For

                End If

            Next

            olReply.Display

        End If

    Next

End Sub

Answer 4

可能与谁有关。

您可以轻松尝试组合提供的解决方案以获得快速结果：

Set myRecipients = olReply.Recipients

Dim y As Long
y = myRecipients.Count

Do Until y = 0
    If myRecipients(y) = "to be removed" Then
    myRecipients(y).Delete
    End If
    y = y - 1
Loop

Outlook宏：删除“全部答复”中的收件人

4 个答案: