最近发邮件老是忘记发送邮件附件,自己写了个vba小程序进行检查,如果title(主题)包含特定字符串,比如公司要求的leave request,time sheet就会进行检查并提示。感觉挺好用。代码和步骤如下。
- 打开outlook
- ALT+F11 进入代码编辑模式
- 在模块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/ 。