Outlook 2010-VBA-在ItemSend中设置密件抄送 [英] Outlook 2010 - VBA - Set bcc in ItemSend
问题描述
程序:Outlook 2010
操作系统: Win8
VBA技能:新手
Program: Outlook 2010
OS: Win8
VBA Skill: Novice
注释:
如果我删除以下选项
Notes:
This works perfectly if I remove the following option
Private Sub Application Item_Send
'[3]
If Item.SendUsingAccount = "Account Name here" Then
如果我不删除它(保留我的密件抄送例外)，则启动Private Sub Application _Startup的电子邮件会运行 ，但它的密件抄送仅项[3]中列出的电子邮件= "special@domain.com".
If I do not remove it (keeping my BCC exception) the email on startup Private Sub Application _Startup runs however it BCCs only the email listed in item [3] = "special@domain.com".
删除零件[3]时，两者均按编码方式运行.
1)启动时发送1封电子邮件，对所有列出的帐户进行密送以检查宏，
2)在当天，所有发送的电子邮件均附有正确的密件抄送，所有例外均按编码方式工作.
When part [3] is removed both run as coded.
1) 1 email on startup, BCCing all accounts listed to check the Macro,
2) During the day all emails sent have the correct BCC attached, all the exceptions work as coded.
似乎我错过了一些东西，这些东西会阻止每封邮件代码运行到启动邮件代码中.
It seems that there is something that I have missed which stops every mail code from running in to the startup mail code.
我尝试了许多更改，包括添加的IF& else功能.
I have tried a number of changes, including added IF & else functions.
两者都在我的此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
推荐答案
我可能是错误的印象是，在您撰写本文时，您还不知道如何调试. http://www.cpearson.com/Excel/DebuggingVBA.aspx
My possibly false impression is, at the time you wrote this, you did not know how to debug. This may have been helpful http://www.cpearson.com/Excel/DebuggingVBA.aspx
这里是简化的未经测试的版本.我删除了所有其他语句.
Here is a simplified untested version. I removed all the Else statements.
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始终为空.
When you debug you will note Item.SendUsingAccount is always blank.
您可以尝试设置SendUsingAccount 在邮件宏中使用所需的邮件帐户，但它比SentOnBehalfOfName(From)有点棘手.请注意，手动设置发件人"不会更新SentOnBehalfOfName.
You can try setting SendUsingAccount Use the mail account you want in your mail macro but it is a little trickier than SentOnBehalfOfName (From). Note manually setting From will not update SentOnBehalfOfName.
您可以看到它是如何工作的.
You can see how it works with this.
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中设置密件抄送的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
