VBA检查发送邮件附件

  最近发邮件老是忘记发送邮件附件，自己写了个vba小程序进行检查，如果title（主题）包含特定字符串，比如公司要求的leave request，time sheet就会进行检查并提示。感觉挺好用。代码和步骤如下。

1.  打开outlook
2.  ALT+F11 进入代码编辑模式
3. 在模块ThisOutlookSession中添加代码并保存即可

  图片为截图

代码如下：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'Pops up a reminder if the word "attach?± is found but there is no attachment on your email.
Dim m As Variant
Dim strBody As String
Dim intIn As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer
Dim strTitle As String
Dim arrLen As Integer
  'title检查文本
checkStr = Array("leave request", "expense sheet", "timesheet", "time sheet", "attach")

Dim hasAtt As Boolean


On Error GoTo handleError
intStandardAttachCount = 1

'for title check
strTitle = LCase(Item.Subject)
    
arrLen = UBound(checkStr)
For i = 0 To arrLen
    intIn = InStr(1, strTitle, checkStr(i))
    If intIn > 0 Then hasAtt = True
    intIn = 0
Next i
    
If hasAtt = True Then
    m = MsgBox("你又忘记附件了！" & vbCrLf & "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

也可以添加别的检查，看自己的需求了。

参考文章：http://www.businesshut.com/outlook-macros/outlook-attachment-reminder-macro/ 。