BCC在Outlook 2007中的ItemSend事件中不再有效

Question

我在ItemSend中插入了代碼並保存了ThisOutlookSession模塊。它曾經工作過，不再有效。它被保存爲VBAproject.OTM，並且在重新啓動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 

Answer 1

如果你掛鉤ItemSend事件，這應該是在類模塊WithEvents和你的代碼來調用它在常規模塊。此外，您還需要在BCC堅持的消息上執行Item.Save。

Answer 2

使用和if語句在該項目的主題領域

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 

或使用，如果你想有一個包含主題

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


End If 

Answer 3

最近，我有這個問題的話。它啓動後，.pst文件以某種方式損壞，我必須運行scanpst.exe（我必須搜索我的驅動器，因爲錯誤消息不會告訴你它在哪裏）

運行scanpst.exe問題出現了，這就是我如何解決它的。

首先，我擺弄着宏觀安全。我將其設置爲最低設置。 Here is a link that covers how to change macro security。轉到工具>宏>安全。我將它設置爲「沒有安全檢查宏」。

然後我用這個確切代碼：

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 

然後我點擊保存按鈕，然後小的綠色播放按鈕來運行宏。它問我一個宏名。我使用了bccUsername並單擊了create。編輯在ThisOutLookSession下添加了一個名爲Modules的部分。

然後我重新啓動Outlook並測試兩次，它的工作。

我不完全確定我做了什麼讓它重新開始工作，但是這並不涉及步驟，所以希望這可以幫助您和其他人解決同樣的問題。