回答編集履歴
1
追記
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
|
+
```
|