当前位置:古侯子 > 古侯子-创新思维 > 查看文章

检查附件的Outlook VBA 代码

检查附件的Outlook VBA 代码

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

最近在工作忙乱之余,折腾了一下OutlookVBA,在网上找了一段代码,功能是:在你用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时,不再进行提示

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

作者:古侯子
言出必行、知行合一
版权保护:本站文章享有原创版权保护,未经授权不得使用,授权点击
本文链接:http://www.houqun.me/?p=632932 转载请注明出处.
如果喜欢:点此订阅本站 每日收到一封来自本站精选文章推送.
7K
    • 热门围观
    • 相关文章
    • 文章评论
       检查附件的Outlook VBA 代码:目前有7 条留言
      1. 板凳
        chenzhen:

        会自动的检测有无”邮件”… …你这里想说的是“附件”吧
        每次来逛都有新鲜收获,加油!

        2011-12-30 5:41 下午 [回复]
        • @chenzhen,

          呵呵,是“附件”,比较粗心大意的写成邮件了。见笑见笑~

          2011-12-31 11:33 下午 [回复]
      2. 沙发
        syskey1:

        博主你好,十分冒昧,向您请教个问题
        就是我现在想用一段vba代码实现以下几个功能:
        1、自动检测收件箱中是否有未读邮件
        2、读取未读邮件的发件者,
        3、将2的内容转存到硬盘上的一个txt文件中。

        我由于VBA以前毫无基础,编写起来十分困难,博主能给我一些相关的代码参考一下吗?

        2012-01-05 12:18 下午 [回复]
        • @syskey1,

          这几个功能肯定可以实现,按说难度也不大。不过最近事情比较多,等闲下来再给你找些代码,不知可否?

          2012-01-09 9:40 下午 [回复]
          • syskey1:

            @古侯子, 您好!

            前段时间经过自己的编写,写出了一些代码,是关于outlook自动检测邮件的,但是现在遇到一个问题,即收件箱检测。具体就是我邮件在时间点1的时候读取收件夹,然后将收件夹的邮件总数存下来,接着用一个循环将邮件中的内容转存,但是在转存的同时,收件夹突然接收到新邮件,这时候程序就会出问题。向您请教下,这个问题怎么处理比较好点?

            2012-03-01 1:38 下午 [回复]
            • @syskey1,

              在“关于古侯子”有我的邮箱,你给我发邮件吧,我们邮件联系。

              2012-03-01 5:12 下午 [回复]
      发表评论

      快捷键:Ctrl+Enter
  •