Question

我在outlook中看到了以下vba编码。

基本上，此编码会为我组织外部的所有外发电子邮件弹出是/否消息框。

编码工作文件，然而，这种情况有时并不能识别它有编码。

但是，当我打开编码窗口（Alt + F11）并在标题中放置一个中断并运行编码时，它会在此之后开始正常工作。

我有双/三重检查，编码没有问题。它与设置有关。

我也启用了所有宏。

有关为何会发生这种情况的任何建议或想法，以及如何克服这一点？

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

On Error Resume Next

If Item.Class <> olMail Then Exit Sub

Dim sCompanyDomain As String: sCompanyDomain = "tell.com"

Const PidTagSmtpAddress As String =     "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

On Error Resume Next

Dim oMail As MailItem: Set oMail = Item
Dim oRecipients As Recipients: Set oRecipients = oMail.Recipients
Dim bDisplayMsgBox As Boolean: bDisplayMsgBox = False

Dim sExternalAddresses As String
Dim oRecipient As Recipient

For Each oRecipient In oRecipients

Dim oProperties As PropertyAccessor: Set oProperties =     oRecipient.PropertyAccessor
    Dim smtpAddress As String: smtpAddress =     oProperties.GetProperty(PidTagSmtpAddress)

    Debug.Print smtpAddress

    If (Len(smtpAddress) >= Len(sCompanyDomain)) Then

    If (Right(LCase(smtpAddress), Len(sCompanyDomain)) <> sCompanyDomain)     Then

' external address found
            If (sExternalAddresses = "") Then

            sExternalAddresses = smtpAddress

        Else

            sExternalAddresses = sExternalAddresses & ", " & smtpAddress

        End If

        bDisplayMsgBox = True

    End If

End If

Next

If (bDisplayMsgBox) Then

Dim iAnswer As Integer
iAnswer = MsgBox("You are about to send this email externally to " & sExternalAddresses & vbCr & vbCr & "Do you want to continue?", vbExclamation + vbYesNo + vbDefaultButton2, "External Email Check")

If (iAnswer = vbNo) Then
    Cancel = True
End If

End If

End Sub

Answer 1

作为最后的手段，将otm文件移动到备份文件夹。

启动Outlook以查找空otm。将上面的代码复制到ThisOutlookSession。

在这个场景中的VBA代码是行不通的

1 个答案: