outLook VBA 根据标题关键字分组密送

  在这里共享一个验证邮件是否有写标题的宏.点击
       使用方法:
       1.下载上面共享的宏.得到一个RAR文件,解压,得到一个txt文件;
       2.打开OutLook,选择  工具-->宏-->Visual Basic编辑器;
       3.在新打开的编辑器中,将左边工程下的项目树节点依次展开.依次是:Project1-->Microsoft Office OutLook对象-->ThisOutlookSession.
       4.双击ThisOutlookSession,打开编辑窗口;
       5.在编辑窗口中拷入下面的代码.保存,关闭.

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim oItem As MailItem
    Dim oRecipient As Recipient
    Set oItem = Item
    
    Dim strSubject As String

    Dim strBody As String

    strSubject = Item.Subject  ' 邮件标题
    
    strBody = Item.Body     ' 邮件内容
    
    If Trim(strSubject)  Like "*催收*"  Then
    
        ' 在这里参考如下代码根据需要增删BCC收件人
        Set oRecipient = oItem.Recipients.Add("arivn@email.com")
        oRecipient.Type = Outlook.olBCC
        Set oRecipient = oItem.Recipients.Add("arivn@email.com")
        oRecipient.Type = Outlook.olBCC
        Set oRecipient = oItem.Recipients.Add("arivn@email.com")
        oRecipient.Type = Outlook.olBCC
       
        
        oItem.Recipients.ResolveAll
        oItem.Save
        Set oRecipient = Nothing
        Set oItem = Nothing
    End If

End Sub

 

二、开启宏

1.首先,在桌面上点击开始按钮,在菜单栏中点击Microsoft Outlook2010。
2.打开软件后,点击文件菜单,在弹出的菜单命令中点击选项。
3.弹出Outlook选项对话框,在左侧的导航栏中点击“信任中心”。
4.右侧窗格显示出信任中心的相关信息,点击信任中心设置按钮。
5.弹出信任中心对话框,在对话框左侧导航中点击“宏设置”。
6、右侧窗格中显示出宏设置选项，点击选择“启用所有宏”，再点击确定即可