Skip to content

Instantly share code, notes, and snippets.

@ictlyh
Created July 29, 2017 02:46
Show Gist options
  • Save ictlyh/45c2f1dc654dc54e2897eec9a10811e9 to your computer and use it in GitHub Desktop.
Save ictlyh/45c2f1dc654dc54e2897eec9a10811e9 to your computer and use it in GitHub Desktop.
Check whether email has a subject and attachment for Outlook
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件
If InStr(1, Item.Body, "附件") <> 0 Then
If Item.Attachments.Count = 0 Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件内容中包含“附件”,但没有上传附件!" & Chr(10) & "仍然发送?", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If
End If
End If
'检查是否写主题
If Item.Subject = "" Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件没有主题!" & Chr(10) & "仍然发送?", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment