Программа: Outlook 2010
ОПЕРАЦИОННЫЕ СИСТЕМЫ: Win8
Навык VBA: послушник

Заметки:
Это прекрасно работает, если я уберу следующую опцию

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

Если я не удаляю его (сохраняя свое исключение BCC), электронная почта при запускеPrivate Sub Application _Startup работаеттем не мение это ОЦКтолько адрес электронной почты, указанный в пункте[3] = "[email protected]".

Когда часть[3] удаляется и запускается как закодировано.
1) 1 электронное письмо при запуске, BCCing всех учетных записей, перечисленных для проверки макроса,
2) В течение дня все отправленные электронные письма имеют правильный BCC, все исключения работают как закодированные.

Кажется, что-то, что я пропустил, останавливаеткаждая почта код от запуска достартовая почта код.

Я перепробовал ряд изменений, в том числе добавил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 = "[email protected]; [email protected]"
    .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 = "[email protected]" Then
            Exit Sub
        Else
            If InStr(1, Item.Body, "zebra") Then
                Exit Sub
            Else
                If Item.To = "[email protected]" Or Item.To = "[email protected]" Then
                    strBcc = "[email protected]"
                    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 = "[email protected]"
                        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 = "[email protected]"
                        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 = "[email protected]"
                        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 = "[email protected]"
                        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