2015-02-23 76 views
0

我在outlook的thisoutlooksession中有以下vba編碼。在thisoutlooksession中的VBA代碼將不起作用

基本上這個編碼彈出了我組織外部所有外發電子郵件的是/否消息框。

編碼工作文件,然而,thisoutlooksession有時不認識到它有一個編碼。

但是,當我打開編碼窗口(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 
+0

「thisoutlooksession有時不認識到它有一個編碼」 - 這是什麼意思? – 2015-02-23 16:29:19

+0

有時編碼不會工作。 – 2015-02-23 16:30:20

+0

你是如何訂閱ItemSend事件的?看到類似的論壇主題 - http://stackoverflow.com/questions/28673582/outlook-open-form-via-vba-makro-and-send-mail-with-settings-of-thisoutlooksessi – 2015-02-23 16:32:11

回答

0

作爲最後的手段將otm文件移動到備份文件夾。

啓動Outlook以查找空otm。將上面的代碼複製到ThisOutlookSession。