计划: Outlook 2010
操作系统: Win8
VBA技能:新手
注释:
如果我删除以下选项,这将非常有效
Private Sub Application Item_Send
'[3]
If Item.SendUsingAccount = "Account Name here" Then
如果我不删除它(保留我的密件抄送异常(exception)),启动时的电子邮件私有(private)子应用程序_Startup
会运行但是它仅密件抄送[3]
项中列出的电子邮件 =“special@domain.com”。
当部分 [3]
被删除时,两者都会按编码运行。
1) 启动时发送 1 封电子邮件,密件抄送列出的所有帐户以检查宏,
2) 白天发送的所有电子邮件均附有正确的密件抄送,所有异常(exception)情况均按编码工作。
似乎我错过了一些东西,可以阻止每个邮件代码运行到启动邮件代码中。
我尝试了许多更改,包括添加了 IF
和 else
函数。
两者都在我的此 Outlook session 中运行
代码:
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
这是一个简化的未经测试的版本。我删除了所有 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
关于vba - Outlook 2010 - VBA - 在 ItemSend 中设置密件抄送,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/21628397/