BCC in ItemSend event in Outlook 2007 no longer works

问题:

I inserted code in ItemSend and saved the ThisOutlookSession module. It worked once and no longer works. It was saved as VBAproject.OTM and is still there when I open the module after restarting Outlook.

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     On Error Resume Next      ''# #### USER OPTIONS ####     ''# address for Bcc -- must be SMTP address or resolvable     ''# to a name in the address book     strBcc = "someone@somewhere.dom"      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 

回答1:

use and if statement on the Item's Subject field

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)  If Item.Subject = "exact match" Then      strBcc = "someone@somewhere.dom"      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     Item.Save      Set objRecip = Nothing   End If 

or use if you want a contains a word in the subject

If InStr(Item.Subject, "BCCSubject") = 0 Then   End If 

回答2:

If you're hooking the ItemSend event, that should be in a class module with WithEvents and your code to call it in a regular module. Also, you'll want to do an Item.Save on the message for the BCC to stick.

回答3:

I was having this issue recently. It started after the .pst file was corrupted in some way and I had to run scanpst.exe (which I had to search my drive for because the error message does not tell you where it is)

After running scanpst.exe and the issue presented itself, this is how I fixed it.

First, I fiddled with macro security. I set it to the lowest setting. Here is a link that covers how to change macro security. Go to Tools > Macro > Security. I set it to "No security check for Macros."

Then I used this exact code:

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 On Error Resume Next  ' #### USER OPTIONS #### ' address for Bcc -- must be SMTP address or resolvable ' to a name in the address book strBcc = "PUT YOUR EMAIL ADDRESS HERE AND LEAVE THE QUOTES"  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 

Then I clicked the save button then little green play button to run the macro. It asked me for a Macro name. I used bccUsername and clicked create. The editor added a section called Modules under ThisOutLookSession.

I then restarted Outlook and tested twice and it worked.

I'm not exactly sure what I did that made it start working again, but this is not too involved with the steps so hopefully this helps you and others with the same problem.

文章来源: BCC in ItemSend event in Outlook 2007 no longer works