检查附件的Outlook VBA 代码

忙里偷闲，无聊的折腾一些小代码。我发现，我还是蛮喜欢折腾这些小代码或者小工具，一来本身很有趣，可以让自己沉迷其中；二来，这些小东西用的好了，也可以提高自己的效率。

最近在工作忙乱之余，折腾了一下Outlook的VBA，在网上找了一段代码，功能是：在你用Outlook发送邮件时，如果你邮件里提到“附件”或“enclose”或“attach”，会自动的检测有无附件；若无附件，则进行提醒；若有，则正常发送。这功能主要应付我这种写邮件常常忘记贴附件的人的。如果你也需要，请见代码如下：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

If TypeName(Item) <> “MailItem” Then Exit Sub

Dim intRes As Integer
Dim strMsg As String
Dim strThismsg As String
Dim intOldmsgstart As Integer

Dim sSearchStrings(2) As String
Dim bFoundSearchstring As Boolean
Dim i As Integer ‘ loop var for FOR-NEXT-loop
bFoundSearchstring = False
sSearchStrings(0) = “attach”
sSearchStrings(1) = “enclose”
sSearchStrings(2) = “附件”

intOldmsgSign0 = InStr(Item.Body, “From:”)
intOldmsgSign1 = InStr(Item.Body, “Sent:”)
intOldmsgSign2 = InStr(Item.Body, “To:”)
intOldmsgSign3 = InStr(Item.Body, “Subject:”)
intOldmsgstart = intOldmsgSign0 + intOldmsgSign1 + intOldmsgSign2 + intOldmsgSign3

If intOldmsgstart = 0 Then
strThismsg = Item.Body + ” ” + Item.Subject
Else
strThismsg = Left(Item.Body, intOldmsgSign0) + ” ” + Item.Subject
End If

For i = LBound(sSearchStrings) To UBound(sSearchStrings)
If InStr(LCase(strThismsg), sSearchStrings(i)) > 0 Then
bFoundSearchstring = True
Exit For
End If
Next i

If bFoundSearchstring Then
If Item.Attachments.Count = 0 Then
strMsg = “Attachment Checker:” & Chr(13) & Chr(10) & “邮件内容提到了附件，但没有找到任何附件！” & Chr(13) & Chr(10) & “确定不添加附件吗？”
intRes = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, “You forgot the attachment!”)
If intRes = vbNo Then
‘ cancel send
Cancel = True
End If
End If
End If

End Sub

具体的用法很简单：

1. 在Outlook的界面下，按“Alt+F11”，进入VBA的编辑界面，如上图（请点开看大图）；

2. 双击左边的“ThisOutlookSession”，右边打开一编辑区

3. 把上面的代码拷进编辑区，保存；重启Outlook，重启前设置Outlook的宏安全设置为“所有宏均提醒”

4. 重启Outlook，选择运行宏，即可启用这段代码；

如此做法，以后每次运行Outlook都会提醒一次，所以可以给自己的代码做数字签名。

1. 在C:\Program Files\Microsoft Office\Office14\下找到SELFCERT.EXE，运行，会弹出如下的界面

2. 填入自己的数字签名，例如我”Will HQ”

3. 在VBA的编辑界面下，在“Tools”菜单下选择“Digital Signature”

4. 在弹出的界面中点击“Choose”，选择第2步做的数字签名，确定

5. 重启Outlook，弹出提示时，选择以后均用此签名，即可以后运行Outlook时，不再进行提示

其实呢，我真正想要的效果是：对每一封我处理过的邮件，例如回复过的邮件，自动存档到存档文件夹中。现在，还未实现该功能。预计，会把此事作为一种玩乐，至于工作的忙乱之中，作为一种休息和调节。