OK，有关使用规则工具对邮件进行分类的部分就介绍这么多，大家可以自己试验一下，就知道这个功能的强大了。

下面来讲解如何使用VBA实现邮件处理自动化。

二、使用VBA实现邮件处理自动化

VBA是Office内嵌的自动化工具，可以让使用者更灵活的，以相对更底层的方式操作Office的各种功能， 它是面向对象的，也是事件驱动的， 并且以类似basic的语言方式来使用，方便使用者快速上手。

我将以一个实际的例子来介绍如何编写一个Outlook的VBA程序。事情是这样：

老婆在总公司做邮件分拣工作，公司的信息化很差，与下属公司通过邮箱来传递文件，下属公司经常会给总公司发一些PDF报表，老婆需要把这些邮件附件按照不同情况分派给不同的同事去处理，对附件进行重命名并做好登记记录。

公司不愿意为这点事投建信息化系统，但由于邮件的量很大，老婆为这点事就要占几个小时，因为上班时候还有工作，所以通常老婆下班就把这个工作带回家，等孩子们都睡了再做，很是辛苦。

后来，老铁就让老婆跟下属公司的人约定一个固定格式的邮件标题，把与分拣有关的内容都写在标题里（比如订单号，订单类型等），然后编写了一个VBA的程序，半自动化的处理邮件，将几个小时的工作时间缩短到十分钟以内。

这个程序需要实现的核心功能很简单——识别邮件标题并进行归类。程序主要对用户点击的邮件进行识别，把邮件标题上的信息摘取出来，附合一些分配人员的信息，将附件下载归类再登记，基本上把原先拷贝复制的工作都简化成点几下鼠标了。

实现这个需求用了600来行代码，

1、开始编写代码

在Outlook中编写代码非常容易，以前如果没有写过代码可能需要先打开“开发工具选项卡”：依次点击文件—选项—自定义功能区，勾选“开发工具”：

代码主要分为两个部分，一是通过用户点击邮件，程序提取所点击邮件的相关信息，二是将相关信息显示在一个窗体上，接受用户修改和指定任务承担人的操作，在用户确认后进行登记和转存附件。

2、核心功能1：点击邮件并识别标题

代码的核心功能之一是用户点击邮件，并对所点击的邮件进行一系列的信息识别和提取。

Office的VBA程序都是事件驱动的，点击邮件识别标题就需要在点击邮件这个事件中进行编程，也就是说，点击了邮件就去执行这段代码。

点击邮件的事件即是：Outlook.Explorer 对象的 SelectionChange()事件，顾名思义，这个事件是在选择变化时触发，触发时，Outlook.Explorer 对象的 Selection 属性存储了当前选择的邮件项目的所有信息。

所以，我们要做的就是建立这个事件，并在事件中处理Selection中的有关信息。

A.声明和建立事件

声明事件：

Public WithEvents myOlExp As Outlook.Explorer ‘全局变量

建立事件：

Private Sub myOlExp_SelectionChange()

End Sub

使用这个事件时，还有一点需要注意，SelectionChange在Outlook启动期间会被触发，选中邮件时又会触发两次，所以需要在事件之初做一些判断，能够对所需要的那次触发做出处理，再添加以下代码：

声明触发计数变量：

Public fireSelChange As Integer '全局变量，触发计数器

在 myOlExp_SelectionChange() 事件中添加代码：

Private Sub myOlExp_SelectionChange()

fireSelChange = fireSelChange + 1 '触发计数

If appInit <> True Then '判定初始化是否完成

If fireSelChange Mod 2 = 0 Then '偶数次触发才是选中所需邮件的那次触发

'核心功能在此处实现

fireSelChange = 2 '还原触发计数为2

End If

ElseIf appInit = True And fireSelChange = 2 Then appInit = False '应用处于启动阶段且已触发两次则设定为应用处于已启动阶段

End If

End Sub

B.获取邮件标题

实现核心功能的思路主要是通过正则表达式对标题进行识别，将识别结果存储在变量中，上文说到邮件内容都包含在Outlook.Explorer 对象的 Selection 属性中，下面来看看具体如何获取邮件标题。

Selection属性是一个集合，可能包含多个项目，这个项目可能是邮件，也可能是联系人、任务等其他Outlook支持的对象，在这里只考虑选择一个邮件项目的情况，所以需要将Selection属性强制转换为 Outlook.MailItem 类型。

声明局部变量：

Dim myOlSel As Outlook.Selection 'Selection 属性

Dim strSubject As String '邮件标题

转换类型：

Set myOlSel = myOlExp.Selection '获得Selection 属性

If myOlSel.Count = 1 Then ‘判断是否选择了 1个项目

If myOlSel.Item(1).Class = OlObjectClass.olMail Then '判断所选的项目是否为 邮件

Set oMail = myOlSel.Item(1) '将邮件赋值给局部变量

strSubject = oMail.Subject '提取邮件标题

End If

End If

提取出邮件标题后，还需要提取很多内容，都可以引用MailItem类的有关属性，例如：

MailItem.Body '邮件正文

MailItem.ReceivedTime '邮件接收时间

MailItem.Attachments '邮件附件集合，可以使用For Each 遍历附件集合，获取附件文件名，另存附件等。

C.正则表达式和启动窗体

VBA中使用正则表达式，可以从下面的代码开始：

Set mRegExp = CreateObject("Vbscript.Regexp")

With mRegExp

.Global = False                              'True表示匹配所有, False表示仅匹配第一个符合项

.IgnoreCase = True                          'True表示不区分大小写, False表示区分大小写

.Pattern = "(b|B|c|C){1}[0-9]{11}"   '匹配字符模式

Set mMatches = .Execute(strSubject)   '执行正则查找，返回所有匹配结果的集合，若未找到，则为空

‘其他内容

End With

经过一系列字符串提取工作，可以将字符串赋值给一个窗体，然后方便用户在窗体上可视化的操作，这个窗体后面具体讲解，这里只看一下如何赋值和显示窗体：

With MailForm

.IDTB.Text = strID '给窗体中IDTB这个文本框（TB即TextBox）设置编号的字符串

.NameTB.Text = strName '给窗体中NameTB这个文本框设置名称的字符串

'……其他代码

.Show '显示窗体

End With

3、核心功能2：在窗体中显示有关数据，并接受用户操作

由于发来的邮件千差万别，很多邮件标题与约定的格式不能百分百一致，因此需要在提取信息后，给用户（也就是我老婆）一个修改的机会，并请人工指定把任务分配给谁，所以需要一个窗体，显示所有提取的信息，让用户指定任务承担人，并在用户确认这些信息后进行登记和存储邮件附件的操作。

窗体设计如下图：

按照业务需求，窗体上提取出的信息最后都会记录到Excel文件中，同时也会合并到附件的文件名中。

使用VBA可以方便的在程序当中调用Excel或者Word等Office组件，并向文件中写入内容，以下代码可以添加到提交按钮的点击事件里：

Set xlapp = CreateObject("Excel.Application") '创建Excel对象。

Set wb = xlapp.workbooks.Open(recPathTB.Text) '打开记录文件

Set sht = wb.Sheets(1) '获取Excel表格的第一个sheet

i = sht.UsedRange.Rows.Count + 1 '计算单元格行数，i 即是定位到现有内容的最后一行。

sht.Cells(i, 1).Value = recvDateTB.Text

'将内容写入单元格

......

wb.Close True '关闭文件

xlapp.Quit '清理实例

4、其他代码

A.实现程序初始化

一般来说都要在Outlook启动时，做一些初始化的工作，程序初始化的事件是 Application_Startup ，可以在这个程序中添加初始化代码：

Private Sub Application_Startup()

Initialize_handler

End Sub

Initialize_handler 是一个自定义的函数，主要功能是在Outlook启动之初添加一个类别标签，并用这个标签来标记已经处理的邮件。标签一经添加，下次启动就会存在不需要再添加，程序也会做出相应判断，具体实现如下：

Sub Initialize_handler()

Dim objNameSpace As NameSpace

Dim objCategory As Category 'Outlook中邮件标签对象，存储了当前已有的标签，例如紧急，普通等

Dim ifFinished As Boolean '标记是否已完成邮件处理的变量

Set myOlExp = Application.ActiveExplorer '代表Outlook窗口界面的对象

appInit = True '标志程序已经初始化

fireSelChange = 0 '初始化触发selecttion_change 事件的次数。

'查看是否有已办的标识

Set objNameSpace = Application.GetNamespace("MAPI")

ifFinished = False

For Each objCategory In objNameSpace.Categories

If objCategory.Name = "已办" Then

ifFinished = True

Exit For

End If

'如果没有已办标识则新增已办标识

If ifFinished = False Then objNameSpace.Categories.Add ("已办")

End Sub

B.获取邮件附件相关信息

项目当中需要检查邮件附件的文件名后缀是否为PDF，所以需要获取邮件附件的相关信息：

邮件附件的对应的对象是 Attachment，存储在MailItem.Attachments集合中，可以通过Foreach来遍历邮件附件，另外为了保证能取到准确的文件扩展名，使用系统自带Scripting.FileSystemObject对象的GetExtesion函数获得，代码如下：

Private Function FindAttachName() As String

Dim oAttachment As Attachment '声明Attachment对象

Dim attachName As String '附件文件名字符串

Dim oFso As Object

Set oFso = CreateObject("Scripting.FileSystemObject") '设置FileSystemObject对象

FindAttachName = "" '设置返回值

For Each oAttachment In oMail.Attachments '遍历附件，oMail是全局变量

If LCase(oFso.GetExtensionName(oAttachment.FileName)) = "pdf" Then '判断附件文件名的扩展名是否为pdf