掃描外部域的電子郵件收件人

Question

我編寫了一些代碼來掃描已發送電子郵件的收件人，並編輯外部域的主題行。但是，如果包含電子郵件通訊組列表，則會引發錯誤。我如何在搜索外部域時處理通訊組列表的成員？

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

Dim strSubject As String 
Dim recips As Outlook.Recipients 
Dim recip As Outlook.Recipient 
Dim pa As Outlook.PropertyAccessor 
Dim outsideEmails() As String 
Dim includesOutsideDomain As Boolean 
Dim i As Integer 
Dim userChoice As Integer 

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

Set recips = Item.Recipients 
ReDim outsideEmails(recips.Count) 

strSubject = Item.Subject 
includesOutsideDomain = False 

i = 0 

For Each recip In recips 
    Debug.Print recip 
    Set pa = recip.PropertyAccessor 
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@example.com") = 0 Then 
     outsideEmails(i) = pa.GetProperty(PR_SMTP_ADDRESS) 
     'On Error Resume Next 
     includesOutsideDomain = True 
    End If 
Next 
If includesOutsideDomain Then 
    If InStr(LCase(strSubject), "encrypt:") = 0 Then 
     userChoice = MsgBox("You may be sending this email to an outside domain without encryption. Would you like to encrypt this message?" _ 
      , vbYesNoCancel + vbCritical + vbMsgBoxSetForeground, "Encryption Warning") 

     Select Case userChoice 
      Case 6: 'yes 
       strSubject = "Encrypt:" & strSubject 
       Item.Subject = strSubject 
      Case 7: 'no 
      Case 2: 'cancel 
       cancel = True 
     End Select 
    End If 
End If 
End Sub 

以下是錯誤： Error Message

Answer 1

如這裏http://www.vbaexpress.com/forum/showthread.php?53174-VBA-to-expand-Outlook-Distribution-Group-before-send

描述此展開通訊組列表和嵌套通訊組列表。

之前就Set recips = Item.Recipients

Sub DLExpand() 

    ' http://www.vbaexpress.com/forum/showthread.php?53174-VBA-to-expand-Outlook-Distribution-Group-before-send 

    Dim currItem As mailitem 
    Dim recips As Recipients 

    Dim innerDistListFound As Boolean 

    Dim i As Long 
    Dim j As Long 

    Set currItem = ActiveInspector.currentItem 
    innerDistListFound = True 

    Do Until innerDistListFound = False 

     Set recips = currItem.Recipients 
     innerDistListFound = False 

     If recips.count = 0 Then GoTo ExitRoutine 

     For j = recips.count To 1 Step -1 

      'Debug.Print recips(j) 

      If recips(j).AddressEntry.DisplayType <> olUser Then 

       ' Expand the dist list 
       For i = 1 To recips(j).AddressEntry.Members.count 

        If recips(j).AddressEntry.Members.Item(i).DisplayType = olUser Then 
         currItem.Recipients.Add (recips(j).AddressEntry.Members.Item(i).Address) 
        Else 
         currItem.Recipients.Add (recips(j).AddressEntry.Members.Item(i).name) 
         innerDistListFound = True 
         'Debug.Print " innerDistListFound: " & innerDistListFound 
        End If 

        Debug.Print "- " & recips(j).AddressEntry.Members.Item(i).name 

       Next 

       recips(j).Delete 
       recips.ResolveAll 
       DoEvents 

      End If 

     Next j 

     recips.ResolveAll 

    Loop 

ExitRoutine: 
    Set currItem = Nothing 
    Set recips = Nothing 

    'Debug.Print "Done." 

End Sub 

Answer 2

是，如果給定的屬性不存在，PropertyAccessor.GetProperty將引發異常。這是設計。您必須期待並捕獲該異常。