Question

计划：Outlook 2010年 操作系统： Win8
VBA技能：新手

备注：
如果我删除以下选项

，这将完美地工作

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

如果我不删除它（保留我的BCC例外），启动时的电子邮件Private Sub Application _Startup会运行但是它仅限项目{em>中列出的电子邮件<{em> 1}} =“special@domain.com”。

当删除部分[3]时，两者都以编码方式运行 1）启动时发送1封电子邮件，将所有列出的帐户BCC以检查宏，
2）白天发送的所有电子邮件都附有正确的BCC，所有例外工作都是编码的。

似乎有一些我错过了阻止每个邮件代码运行到启动邮件代码的内容。

我尝试了一些更改，包括添加了[3]＆amp; IF功能。

两者都在我的此Outlook会话

中运行

代码：

else

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

Answer 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

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

1 个答案: