宛先がExchangeかどうかを判別するマクロ

Outlookのマクロで宛先がExchangeのアドレスかどうかを判別したいです。

メールの宛先アドレスが特定のドメイン(社内ドメイン)かそうでないかを判別して
「本当にこのまま送りますか？」というメッセージボックスを出すマクロを今まで設定していました。

これまではPOPメールだったので「MailItemプロパティ」を使って
「オブジェクトを表す変数.Recipients」で宛先アドレスが取得できていたのですが、
社内の一部のメンバーが同じドメイン名のままExchangeに切り替わったことにより
「オブジェクトを表す変数.Recipients」のままでは宛先アドレスが取得できなくなってしまいました。

https://qiita.com/nukie_53/items/23b46841b291125cbab4

こちらのサイトを参考に、まずExchangeかどうかを切り分けて
Exchangeの場合は「GetExchangeUser()」を使って宛先アドレスを取得したいと思うのですが、送信者の識別では「オブジェクトを表す変数.SenderEmailType」になっている部分を受信者の識別では何に変えたらいいのかわからず困っています。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

宛先がPOPメールかExchangeかで処理を切り分けるために、宛先がどちらなのかを識別する方法が一番知りたい情報になります。

　　　　　　　　↓↓↓↓

宛先がExchangeかどうかの切り分けは自力でなんとかなりました！

「オブジェクトを表す変数.Recipients」で、POPメールの場合は宛先アドレスが取得できますが、
Exchangeの場合は「/o=組織名/ou=管理グループ/cn=Recipients/cn=名前またはエイリアス」の形式で「/o=ExchangeLabs/ou=Exchange Administrative Group
(FYDIBOHF23SPDLT)/cn=Recipients/cn=文字化け」な感じで出てくるので、アドレスは文字化けしていますがExchangeかどうかは判別できました。

切り分けはできたので、その後のExchangeだった場合の宛先の取得を頑張ってみます！

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

CHERRY

2020/05/29 01:38 編集

回答としては、中途半端なのでこちらで... Exchange 利用者で実行するのであれば、[AddressEntry. GetExchangeUser メソッド (Outlook)]( https://docs.microsoft.com/ja-JP/office/vba/api/Outlook.AddressEntry.GetExchangeUser ) で、情報を取得できるか確認して、取得できない場合は、組織内Exchange 以外のユーザーと判断できますが、Exchange 利用者以外が Exchange 利用者を判断することってできるのかなぁ...

imihito

2020/05/29 10:05

Recipient.AddressEntry.AddressEntryUserType プロパティが使えそうな雰囲気がしますが、 CHERRY さんの懸念の「Exchange 利用者以外が Exchange 利用者を判断することってできるのかなぁ...」もあり、実際に試してみないとわからなさそうですね。 https://docs.microsoft.com/ja-JP/office/vba/api/outlook.addressentry.addressentryusertype https://docs.microsoft.com/ja-JP/office/vba/api/outlook.oladdressentryusertype

行動規範の内容に同意します

回答2件

自己解決

宛先がExchangeかどうかの切り分けは自力でなんとかなりました！

切り分けはできたので、その後のExchangeだった場合の宛先の取得を頑張ってみます！

投稿2020/06/01 02:42

mugikuma

総合スコア1

mugikuma

2020/06/02 01:03

宛先の取得も解決しましたー！ Set myNameSpace = Application.GetNamespace("MAPI") Set myAddressList = myNameSpace.AddressLists("Offline Global Address List") Set myAddressEntry = myAddressList.AddressEntries("探す宛先") If myAddressEntry Is Nothing Then　・・・・・これで宛先がGALに存在するかを判別して注意ポップアップを出すことができました。

行動規範の内容に同意します

送信押したときでしたら、これ試してみてください。

VBA
1Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
2    Dim To_Addr, CC_Addr, BC_Addr
3    Dim req_Addr, opt_Addr
4    Select Case Item.Class
5      Case Is = 43 ' olMail
6        MsgBox Item.To
7        If Item.Recipients.Count > 0 Then
8          To_Addr = ""
9          CC_Addr = ""
10          BC_Addr = ""
11          For Each R_itms In Item.Recipients
12            Select Case R_itms.Type
13            Case Is = 1 'To
14              To_Addr = To_Addr + R_itms.Address & vbCrLf
15            Case Is = 2 'CC
16              CC_Addr = CC_Addr + R_itms.Address & vbCrLf
17            Case Is = 3 'BCC
18              BC_Addr = BC_Addr + R_itms.Address & vbCrLf
19            End Select
20          Next
21          MsgBox "To ===========" & vbCrLf & To_Addr & vbCrLf & _
22                 "CC ===========" & vbCrLf & CC_Addr & vbCrLf & _
23                 "BCC ==========" & vbCrLf & BC_Addr
24        End If
25        '送信キャンセル
26        Cancel = True
27            
28      Case Is = 53 ' olMeetingRequest
29        MsgBox Item.RequiredAttendees
30        If Item.Recipients.Count > 0 Then
31          req_Addr = ""
32          opt_Addr = ""
33          For Each R_itms In Item.Recipients
34            Select Case R_itms.Type
35            Case Is = 1 'requiredAttendees
36              req_Addr = req_Addr + R_itms.Address & vbCrLf
37            Case Is = 2 'optionalAttendees
38              opt_Addr = opt_Addr + R_itms.Address & vbCrLf
39            Case Is = 3 '?
40             
41            End Select
42          Next
43          MsgBox "必須出席者 ===" & vbCrLf & req_Addr & vbCrLf & _
44                 "任意出席者 ===" & vbCrLf & opt_Addr
45                 
46        End If
47        '送信キャンセル
48        Cancel = True
49      
50      End Select
51    
52End Sub
53

追記

VBA
1Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
2    Select Case Item.SendUsingAccount.AccountType
3    Case Is = olExchange
4      MsgBox "ExchangeユーザーのPC"
5      'https://qiita.com/nukie_53/items/23b46841b291125cbab4さんの方法
6    Case Is = olPop3
7      MsgBox "Pop3ユーザーのPC"
8      '今までの方法
9    Case Else
10      MsgBox "Else"
11    End Select
12    
13    Cancel = True
14End Sub
15

投稿2020/05/28 09:59

編集2020/05/29 08:19

sinzou

総合スコア392

mugikuma

2020/05/29 00:47

ご回答ありがとうございます！早速試してみたのですが、こちらも「MailItemプロパティ」での取得なので、やはりExchangeのアドレスだとうまく取得できませんでした。宛先がPOPメールかExchangeかで処理を切り分けるために、宛先がどちらなのかを識別する方法が一番知りたい情報になります。お手数をお掛けいたしますが、ご存知の方がいらっしゃいましたら是非教えていただきたいです。