Outlook 2010-VBA-Establecer bcc en ItemSend

outlook-vba

Question

Programa: Outlook 2010
Sistema operativo: Win8
Habilidad VBA: novato

Notas:
Esto funciona perfectamente si elimino la siguiente opción

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

Si no lo Private Sub Application _Startup (manteniendo mi excepción BCC), el correo electrónico en el inicio de Private Sub Application _Startup ejecuta, sin embargo , BCCs solo el correo electrónico enumerado en el elemento [3] = "[email protected]".

Cuando se elimina la parte [3] ambos se ejecutan como codificados.
1) 1 correo electrónico al inicio, BCCing todas las cuentas enumeradas para verificar la macro,
2) Durante el día, todos los correos electrónicos enviados tienen el BCC correcto adjunto, todas las excepciones funcionan como codificadas.

Parece que hay algo que me he perdido que impide que todos los códigos de correo se ejecuten en el código de correo de inicio .

He intentado una serie de cambios, incluyendo funciones adicionales de IF y else .

Ambos se ejecutan en mi sesión de esta perspectiva

Código:

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

Answer 1

Mi posible impresión falsa es que, en el momento en que escribiste esto, no sabías cómo depurar. Esto puede haber sido útil http://www.cpearson.com/Excel/DebuggingVBA.aspx

Aquí hay una versión simplificada no probada. Eliminé todas las declaraciones de 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 = "[email protected]" Then Exit Sub
    If InStr(1, Item.Body, "zebra") Then Exit Sub

    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

        GoTo ExitRoutine

    End If

    ''[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

        GoTo ExitRoutine

    End If


    '' #### 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
            GoTo ExitRoutine
        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
            GoTo ExitRoutine
        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

ExitRoutine:
    Set objRecip = Nothing

End Sub

Cuando depure, observará Item.SendUsingAccount siempre en blanco.

Puede intentar configurar SendUsingAccount Use la cuenta de correo electrónico que desee en su macro de correo, pero es un poco más complicado que SentOnBehalfOfName (From). Tenga en cuenta que la configuración manual de From no actualizará SentOnBehalfOfName.

Puedes ver cómo funciona con esto.

Sub SetSentOnBehalf()

Dim objMsg As MailItem

Set objMsg = Application.CreateItem(0)

objMsg.SentOnBehalfOfName = "[email protected]"

objMsg.Display

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

Set objMsg = Nothing

End Sub