-
Notifications
You must be signed in to change notification settings - Fork 1
/
AttachmentReminder.bas
60 lines (49 loc) · 3.03 KB
/
AttachmentReminder.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
' This code checks each outgoing message to see if the user meant to attach something but forgot '
' Allows user to cancel sending if they did really mean to attach something, or continue otherwise '
' Will stop checking if it hits a line with "From: " - this is to minimize false positives if you're just replying to somebody that sent an attachment
' Usage - add to the ThisOutlookSession in the code editor in Outlook. Should fire on all emails sent thereafter
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim Message() As String
Dim Catchwords() As Variant
Dim Catchsubjects() As Variant
Dim possibleAttachment As Boolean
Const SEARCHUNTIL = "From: " ' Search until this phrase if the message is a reply or forward
Message = Split(Item.Body, vbLf)
' These are the words to catch - more can be added using the syntax below
Catchwords = Array("attach", "attached", "attaching", "attachments", "enclosed")
' Add any subjects that need catching here (in case there's no words that indicate an attachment, but the subject implies one)
' Eg if an email goes out regularly that should always have an attachment, but it's not stated in the body, we can still catch it
Catchsubjects = Array("Test", "Testing")
On Error GoTo handleError
possibleAttachment = False
' Only check email if there's no attachments - must be modified if email signature includes a picture, as that counts as an attachment!
If Item.Attachments.Count = 0 Then
' If the item's subject is one of the flagged ones then catch the missing attachment
' Code to be added
For Each Line In Message
If InStr(Line, SEARCHUNTIL) = 0 And possibleAttachment = False Then
For Each word In Catchwords
' This will catch the keywords but not anything with a keyword followed by a question mark
' The question mark bit is meant to weed out false positives - eg "can you send me the attachment?"
If (InStr(LCase$(Line), word) <> 0) And (InStr(LCase$(Line), word & "?") = 0) Then
possibleAttachment = True
Exit For ' Optimization to speed things up - since we only need one possible attachment, exit once found
End If
Next
Else
Exit For ' We've hit a boundary, most likely below this line is the message being replied to / forwarded
End If
Next
End If
' This is what pops up the message box - customize text here
If possibleAttachment Then
SendWithoutAttachment = MsgBox("Send message without attachment?", vbQuestion + vbYesNo + vbMsgBoxSetForeground + vbDefaultButton2)
If Not SendWithoutAttachment = vbYes Then
Cancel = True
End If
End If
handleError:
If Err.Number <> 0 Then
MsgBox "Outlook Attachment Reminder Error: " & Err.Description, vbExclamation, "Outlook Attachment Reminder Error"
End If
End Sub