Outlook 2010 - VBA - 在 ItemSend 中设置密件抄送答案

【问题标题】：Outlook 2010 - VBA - Set bcc in ItemSendOutlook 2010 - VBA - 在 ItemSend 中设置密件抄送
【发布时间】：2014-03-04 21:40:33
【问题描述】：

程序： Outlook 2010
操作系统： Win8
VBA 技能： 新手

注意事项：
如果我删除以下选项，这将非常有效

Private Sub Application Item_Send  
'[3]
If Item.SendUsingAccount = "Account Name here" Then

如果我不删除它（保持我的密件抄送例外），启动时Private Sub Application _Startup 的电子邮件会运行但是它会密件抄送仅项目[3] 中列出的电子邮件= “特殊@domain.com”。

当[3] 部分被删除时，两者都按编码运行。
1) 启动时发送 1 封电子邮件，密件抄送列出的所有帐户以检查宏，
2) 白天发送的所有电子邮件都附有正确的密件抄送，所有例外情况均按编码工作。

似乎我错过了一些东西，它阻止了每封邮件代码运行到启动邮件代码。

我尝试了许多更改，包括添加了IF 和else 函数。

两者都在我的 此 Outlook 会话中运行

代码：

Private Sub Application_Startup()
'Creates a new e-mail item and modifies its properties on startup
'Testing email settings, checking Macros enabled

Dim olApp As Outlook.Application
Dim objMail As Outlook.mailItem
Set olApp = Outlook.Application

'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)

With objMail
    .Subject = "Login Test" & " | " & Format(Now, "YYYYMMDD - HH:mm:ss")
    .Body = "Testing the BCC" & " | " & Format(Now, "YYYYMMDD")
    .To = "1.alerts@domain.com; device@domain.com"
    .Recipients.ResolveAll
    .Send
End With
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'source:    http://www.outlookcode.com/article.aspx?id=72
    'source:    http://www.outlookforums.com/threads/89987-auto-bcc-vba-macro-how-add-exceptions/  (exceptions)  [2]
    'source:    http://www.groovypost.com/howto/microsoft/how-to-automatically-bcc-in-outlook-2010/#comment-312919 (sendusing) [3]


    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    'On Error Resume Next

    '[2]
    If Item.Categories = "zBCC no" Then
        Exit Sub
    Else
        If Item.To = "personal@domain.com" Then
            Exit Sub
        Else
            If InStr(1, Item.Body, "zebra") Then
                Exit Sub
            Else
                If Item.To = "1@domain.com" Or Item.To = "2@domain.com" Then
                    strBcc = "3@domain.com"
                    Set objRecip = Item.Recipients.Add(strBcc)
                    objRecip.Type = olBCC
                    If Not objRecip.Resolve Then
                        strMsg = "Could not resolve the Bcc recipient. " & _
                        "Do you want still to send the message?"
                        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                        "Could Not Resolve Bcc Recipient")
                        If res = vbNo Then
                            Cancel = True
                        End If
                    End If
                    Exit Sub
                Else
                    '[3]
                    If Item.SendUsingAccount = "Account Name here" Then
                        strBcc = "special@domain.com"
                        Set objRecip = Item.Recipients.Add(strBcc)
                        objRecip.Type = olBCC
                        If Not objRecip.Resolve Then
                            strMsg = "Could not resolve the Bcc recipient. " & _
                            "Do you want still to send the message?"
                            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                            "Could Not Resolve Bcc Recipient")
                            If res = vbNo Then
                                Cancel = True
                            End If
                        End If
                        Exit Sub
                    Else
                        ' #### USER OPTIONS ####
                        ' address for Bcc -- must be SMTP address or resolvable to a name in the address book
                        strBcc = "1@domain.com"
                        Set objRecip = Item.Recipients.Add(strBcc)
                        objRecip.Type = olBCC
                        If Not objRecip.Resolve Then
                            strMsg = "Could not resolve the Bcc recipient. " & _
                            "Do you want still to send the message?"
                            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                            "Could Not Resolve Bcc Recipient")
                            If res = vbNo Then
                                Cancel = True
                            End If
                        End If

                        strBcc = "2@domain.com"
                        Set objRecip = Item.Recipients.Add(strBcc)
                        objRecip.Type = olBCC
                        If Not objRecip.Resolve Then
                            strMsg = "Could not resolve the Bcc recipient. " & _
                            "Do you want still to send the message?"
                            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                            "Could Not Resolve Bcc Recipient")
                            If res = vbNo Then
                                Cancel = True
                            End If
                        End If

                        strBcc = "3@domain.com"
                        Set objRecip = Item.Recipients.Add(strBcc)
                        objRecip.Type = olBCC

                        If Not objRecip.Resolve Then
                            strMsg = "Could not resolve the Bcc recipient. " & _
                            "Do you want still to send the message?"
                            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                            "Could Not Resolve Bcc Recipient")
                            If res = vbNo Then
                                Cancel = True
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If

    Set objRecip = Nothing
End Sub

【问题讨论】：

您的 IF 结构非常复杂。您可以先减少 3 个 If/endif，但在一行中指定类似 If Item.Categories = "zBCC no" Then Exit Sub 的内容。其他人也一样
快速提问。为什么每次都为 BCC 分配新值？或者你真的想做strBcc = strBcc & ";" & "2@domain.com"
@PradeepKumar 那个问题稍后会出现；）当我只想要 4 个电子邮件地址时，如何减少代码量 :) 我一直在尝试使用 email; email 和变体，但不断得到错误，我现在就按你的方法试试。
@PradeepKumar，回复您的IF 问题，我已经减少了它们。我已经剪切并粘贴了代码的不同部分，所以我不知道如何简化其中的任何部分。回复 strBcc = "1@mail.com" strBcc = strBcc & ";" & "2@mail.com" 我收到无法解析错误，当我收到解析消息框时，我收到另一个错误：操作失败。无论每次密件抄送字段是否正确填写。
没有。您必须检查 strbcc 是否已经包含某些内容，然后附加到它。例如If strBcc = "" Then strBcc = "1@domain.com" Else strBcc = strBcc & ";" & "1@domain.com"

标签： vba outlook bcc

【解决方案1】：

我可能的错误印象是，在你写这篇文章的时候，你不知道如何调试。这可能会有所帮助http://www.cpearson.com/Excel/DebuggingVBA.aspx

这是一个未经测试的简化版本。我删除了所有 Else 语句。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'source:    http://www.outlookcode.com/article.aspx?id=72
    'source:    http://www.outlookforums.com/threads/89987-auto-bcc-vba-macro-how-add-exceptions/  (exceptions)  [2]
    'source:    http://www.groovypost.com/howto/microsoft/how-to-automatically-bcc-in-outlook-2010/#comment-312919 (sendusing) [3]


    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String

    '[2]
    If Item.Categories = "zBCC no" Then Exit Sub
    If Item.To = "personal@domain.com" Then Exit Sub
    If InStr(1, Item.Body, "zebra") Then Exit Sub

    If Item.To = "1@domain.com" Or Item.To = "2@domain.com" Then

        strBcc = "3@domain.com"
        Set objRecip = Item.Recipients.Add(strBcc)
        objRecip.Type = olBCC

        If Not objRecip.Resolve Then
            strMsg = "Could not resolve the Bcc recipient. " & _
              "Do you want still to send the message?"
            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
              "Could Not Resolve Bcc Recipient")
            If res = vbNo Then
                Cancel = True
            End If
        End If

        GoTo ExitRoutine

    End If

    '[3]
    If Item.SendUsingAccount = "Account Name here" Then

        strBcc = "special@domain.com"
        Set objRecip = Item.Recipients.Add(strBcc)
        objRecip.Type = olBCC

        If Not objRecip.Resolve Then
            strMsg = "Could not resolve the Bcc recipient. " & _
              "Do you want still to send the message?"
            res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
              "Could Not Resolve Bcc Recipient")
            If res = vbNo Then
                Cancel = True
            End If
        End If

        GoTo ExitRoutine

    End If


    ' #### USER OPTIONS ####
    ' address for Bcc -- must be SMTP address or resolvable to a name in the address book

    strBcc = "1@domain.com"
    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC

    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
          "Do you want still to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
          "Could Not Resolve Bcc Recipient")
        If res = vbNo Then
            Cancel = True
            GoTo ExitRoutine
        End If
    End If

    strBcc = "2@domain.com"
    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC

    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
          "Do you want still to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
          "Could Not Resolve Bcc Recipient")
        If res = vbNo Then
            Cancel = True
            GoTo ExitRoutine
        End If
    End If

    strBcc = "3@domain.com"
    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC

    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
          "Do you want still to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
           "Could Not Resolve Bcc Recipient")
        If res = vbNo Then
            Cancel = True
        End If
    End If

ExitRoutine:
    Set objRecip = Nothing

End Sub

调试时会注意到 Item.SendUsingAccount 始终为空。

您可以尝试设置 SendUsingAccount Use the mail account you want in your mail macro，但它比 SentOnBehalfOfName (From) 要复杂一些。注意手动设置 From 不会更新 SentOnBehalfOfName。

您可以看到它是如何工作的。

Sub SetSentOnBehalf()

Dim objMsg As MailItem

Set objMsg = Application.CreateItem(0)

objMsg.SentOnBehalfOfName = "bingo@bongo.com"

objMsg.Display

MsgBox " SentOnBehalfOfName in the From: " & objMsg.SentOnBehalfOfName

Set objMsg = Nothing

End Sub

【讨论】：