teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

追記

2020/02/17 09:15

投稿

sinzou
sinzou

スコア392

answer CHANGED
@@ -2,4 +2,44 @@
2
2
 
3
3
  指定されたドメイン以外への送信を防ぐマクロ
4
4
 
5
- 参考になれば。
5
+ 参考になれば。
6
+
7
+ 追記します。
8
+
9
+ https://qiita.com/scrtree/items/b53de8861d247541c299  意外と知られていないOutlookで開発する方法
10
+ 上記でVBA開始準備説明あります。
11
+
12
+ https://www.eripyon.com/mt/2013/04/outlook_2013.html  Outlookで送信前に送信先と添付忘れを確認するメッセージを表示するの巻
13
+ 上記でSub Application_ItemSendへのプログラム書き方説明あります。
14
+
15
+ で「指定されたドメイン以外への送信を防ぐマクロ」さんのコード拝借して
16
+ ```
17
+ Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
18
+ Dim arrAllowedDomains
19
+ ' 送信可能なドメイン名を指定
20
+ arrAllowedDomains = Array("example.com", "contoso.com")
21
+
22
+ Dim oRec As Recipient
23
+ Dim i As Integer
24
+ Dim strErr As String
25
+ Dim bAllow As Boolean
26
+ For Each oRec In Item.Recipients '宛先
27
+ bAllow = False
28
+ For i = 0 To UBound(arrAllowedDomains)
29
+ If oRec.Address Like "*@" & arrAllowedDomains(i) Then
30
+ bAllow = True
31
+ Exit For
32
+ End If
33
+ Next
34
+ ' 送信可能なドメインではない受信者が存在したら
35
+ If bAllow = True Then
36
+ Cancel = True '送信キャンセル
37
+ strErr = strErr & oRec.Address & ";"
38
+ End If
39
+ Next
40
+ ' 送信がキャンセルされた場合にはエラー表示
41
+ If Cancel Then
42
+ MsgBox "以下のアドレスへの送信は許可されていません。" & vbCrLf & strErr
43
+ End If
44
+ End Sub
45
+ ```