我想在VBA outlook 2016中编写一个代码,在我发送的每封邮件中发送BCC,我有很多发件人邮件,一个Outlook帐户上有很多电子邮件。
因此,每次我发送电子邮件至x@domaine.com时,都会自动发送来自x@domaine.com的BCC电子邮件,如果我从y@domaine1.com发送,则会发送电子邮件至y@domaine1.com
我尝试了这段代码,但它不起作用,并且在我的安全宏中都启用了
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
Dim myOlApp As Outlook.Application
Dim myOlMsg As Outlook.MailItem
On Error Resume Next
Set myOlApp = CreateObject("Outlook.Application")
Set myMsg = myOlApp.ActiveInspector.CurrentItem
strBcc = myMsg.SenderEmailAddress
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
Set objRecip = Nothing
End Sub
答案 0 :(得分:0)
对您的问题感到有些困惑,假设您在展望中设置了多个帐户,那么这应该会为您提供 CurrenUser
。获取当前登录用户名称的属性。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNamespace As Outlook.NameSpace
Dim olRec As Outlook.Recipient
Dim Address$
Set olNamespace = Application.GetNamespace("MAPI")
Address = olNamespace.CurrentUser
Set olRec = Item.Recipients.Add(Address)
olRec.Type = olBCC
olRec.Resolve
End Sub
答案 1 :(得分:0)
正在发送的项目作为参数传递给您的代码,请勿使用myOlApp.ActiveInspector.CurrentItem
。检查员可能已经关闭,或者可能已将消息创建为内联响应。
答案 2 :(得分:0)
尝试SendUsingAccount
请参阅https://msdn.microsoft.com/en-us/library/office/ff869311.aspx
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As vbMsgBoxResult
Dim strBcc As String
'Dim myOlApp As Outlook.Application
'Dim myOlMsg As Outlook.MailItem
' hides errors, this is not a good thing
'On Error Resume Next
' You can use the already running instance of Outlook
'Set myOlApp = CreateObject("Outlook.Application")
' CurrentItem is Item: ByVal Item As Object
'Set myMsg = myOlApp.ActiveInspector.CurrentItem
'strBcc = myMsg.SenderEmailAddress
strBcc = Item.SendUsingAccount
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
Set objRecip = Nothing
End Sub