Outlook2010利用规则运行脚本，将附件保存在固定位置，并在邮件类别中标注类别。

首先要确认触发邮件脚本的规则，比如标题所含字符、固定发件人、附件名称等。

具体规则创建就不再赘述。

规则中选择符合条件即“运行脚本”。

首先检查存储文件夹是否存在，如果不存在则提示建立。 然后调用“SaveFile”过程对符合条件的附件进行存储。

Public Sub SaveAttachmentFromMyMail(item As Outlook.MailItem)
    Dim myFso As New FileSystemObject
    Dim FileSavePath As String
    Dim RetMessage As Integer
    Dim objCate As Category
    Dim strCategories As String
    FileSavePath = "G:\资料"
    If myFso.FolderExists(FileSavePath) = False Then
        RetMessage = MsgBox("默认存储文件夹[" & FileSavePath & "]不存在，是否创建？", vbYesNo, "提示")
        If RetMessage = 6 Then
            myFso.CreateFolder FileSavePath
        End If
    End If
    SaveFile item, FileSavePath & "\", "CH*.xls*"
    item.Categories = "OK" '设置类别
    item.Save
End Sub

SaveFile过程是遍历所有附件，将符合条件的附件保存到设置目录中

Private Sub SaveFile(ByVal item As Object, path As String, Optional condition$ = "*")
    Dim objAtt As Attachment
    Dim i As Integer
    If item.Attachments.Count > 0 Then
        For i = 1 To item.Attachments.Count
            Set objAtt = item.Attachments(i)
            If objAtt.FileName Like condition Then
                objAtt.SaveAsFile path & objAtt.FileName
            End If
        Next
    End If
    Set objAtt = Nothing
End Sub

以下是OUTLOOK2010类别相关过程

'追加一个项目类别
Private Sub AddCategory()
    Dim objNameSpace As NameSpace
    Dim objCategory As Category
    Set objNameSpace = Application.Session
    If Not CategoryExists("OK") Then
        Set objCategory = objNameSpace.Categories.Add("OK", 10)
    End If
End Sub

 
  
'检查项目类别是否存在
Public Function CategoryExists(s As String) As Boolean
    Dim objNameSpace As NameSpace
    Dim objCategory As Category
    CategoryExists = False
    Set objNameSpace = Application.Session
    For Each objCategory In objNameSpace.Categories
        If objCategory.Name = s Then
            CategoryExists = True
            Exit For
        End If
    Next
End Function
 
  
 
  
 
  
 具体参看OUTLOOK VBA 帮助文件。以及《 
  Programming Applications for Microsoft Office Outlook 2007》