(Adapted slightly from Mark Bird's blog.)
In Outlook 2010:
- Click on File > Options > Trust Center > Trust Center Settings > Macro Settings > Enable all macros (read the warning first)
- Click OK twice to save options
- Press Alt-F11
- Expand the project tree on the left, and double-click "ThisOutlookSession"
- Click in the right-hand pane, and paste in the code below
- Restart Outlook again (saving changes when prompted)
Here's the code to paste in:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim m As Variant Dim strBody As String Dim intIn As Long Dim intAttachCount As Integer, intStandardAttachCount As Integer On Error GoTo handleError 'Edit the following line if you have a signature on your email that includes images or other files. Make intStandardAttachCount equal the number of files in your signature. intStandardAttachCount = 0 strBody = LCase(Item.Body) ' text-only reply? intIn = InStr(1, strBody, "original message") If intIn = 0 Then ' html reply? intIn = InStr(1, strBody, "from: ") If intIn = 0 Then intIn = Len(strBody) Else intIn = Len(strBody) End If intIn = InStr(1, Left(strBody, intIn), "attach") intAttachCount = Item.Attachments.Count If intIn > 0 And intAttachCount <= intStandardAttachCount Then m = MsgBox("It appears that you mean to send an attachment," & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send?", vbQuestion + vbYesNo + vbMsgBoxSetForeground) If m = vbNo Then Cancel = True End If handleError: If Err.Number <> 0 Then MsgBox "Outlook Attachment Reminder Error: " & Err.Description, vbExclamation, "Outlook Attachment Reminder Error" End If End Sub
No comments:
Post a Comment