外部ドメインの電子メール受信者をスキャンする

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は、例外が発生します。これは設計によるものです。その例外を予期しトラップする必要があります。