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

在项目的主题字段上使用和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 2

如果您正在挂钩ItemSend事件，那么该事件应位于具有WithEvents的类模块中，并且您的代码将在常规模块中调用它。此外，您还需要对消息进行Item.Save以便BCC坚持下去。

Answer 3

我最近遇到了这个问题。它在.pst文件以某种方式损坏后启动，我不得不运行scanpst.exe（我必须搜索我的驱动器，因为错误消息不会告诉你它在哪里）

运行scanpst.exe后出现问题，这就是我修复它的方法。

首先，我摆弄了宏安全问题。我将其设置为最低设置。 Here is a link that covers how to change macro security。转到工具＆gt;宏＆gt;安全。我将其设置为“没有宏的安全检查。”

然后我使用了这个确切的代码：

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。编辑在Modules下添加了一个名为ThisOutLookSession的部分。

然后我重新启动了Outlook并进行了两次测试，它确实有效。

我不确定我做了什么让它再次开始工作，但这并没有太多涉及步骤，所以希望这可以帮助你和其他人有同样的问题。

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

3 个答案: