计划:Outlook 2010
操作系统:Win8
VBA技能:新手
笔记:
如果我删除以下选项,这将完美工作
Private Sub Application Item_Send
'[3]
If Item.SendUsingAccount = "Account Name here" Then
如果我不删除它(保留我的密件抄送例外),则启动
Private Sub Application _Startup
的电子邮件会运行,但是它仅对[3]
=“ [email protected]”中列出的电子邮件进行密件抄送。删除部分
[3]
时,两者均按编码运行。1)启动时发送1封电子邮件,对所有列出的帐户进行密送以检查宏,
2)在当天,所有发送的电子邮件均附有正确的密件抄送,所有例外均按编码方式工作。
似乎有些东西我错过了,它阻止了每个邮件代码运行到启动邮件代码中。
我尝试了许多更改,包括添加的
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
最佳答案
我可能是错误的印象,在您撰写本文时,您还不知道如何调试。这可能对您有所帮助http://www.cpearson.com/Excel/DebuggingVBA.aspx
这是一个简化的未经测试的版本。我删除了所有其他语句。
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
调试时,您会注意到Item.SendUsingAccount始终为空。
您可以尝试设置SendUsingAccount Use the mail account you want in your mail macro,但是它比SentOnBehalfOfName(From)稍微复杂一些。请注意,手动设置“发件人”不会更新SentOnBehalfOfName。
您可以看到它是如何工作的。
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