如何根据附件文件名将邮件移动到文件夹?

时间:2012-09-05 13:59:51

标签: vba attachment outlook-vba outlook-2010

我需要一个规则(或者很可能是一个VBA宏)来对我的邮件进行排序。如果我在新收到的邮件附件的文件名中说“REPORT”比我想将邮件移到另一个文件夹,请说“REPORTS”文件夹。

我怎样才能做到这一点?

我已经在邮件标题上设置了规则,但似乎没有解决问题。

提前致谢!

1 个答案:

答案 0 :(得分:0)

来自http://www.outlookcode.com/article.aspx?id=62http://blog.saieva.com/2010/03/27/move-messages-to-folders-with-outlook-vba/

的已使用代码
'code goes in "ThisOutlookSession" module
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim arr() As String
    Dim i As Integer
    Dim ns As Outlook.NameSpace
    Dim itm As MailItem
    Dim m As Outlook.MailItem
    Dim att As Outlook.Attachment

    On Error Resume Next
    Set ns = Application.Session
    arr = Split(EntryIDCollection, ",")
    For i = 0 To UBound(arr)
        Set itm = ns.GetItemFromID(arr(i))
        If itm.Class = olMail Then
            Set m = itm
            If m.Attachments.Count > 0 Then
                For Each att In m.Attachments
                    If UCase(att.FileName) Like "*REPORT*" Then
                        MoveToFolder m, "MoveTest"
                        Exit For
                    End If
                Next att
            End If
        End If
    Next
    Set ns = Nothing
    Set itm = Nothing
    Set m = Nothing
End Sub


Sub MoveToFolder(mItem As MailItem, folderName)

 '###you need to edit this for your account name###
 Const mailboxNameString As String = "Mailbox - firstname lastname"

 Dim olApp As New Outlook.Application
 Dim olNameSpace As Outlook.NameSpace
 Dim olDestFolder As Outlook.MAPIFolder

 Set olNameSpace = olApp.GetNamespace("MAPI")
 Set olDestFolder = olNameSpace.Folders(mailboxNameString).Folders(folderName)

 Debug.Print "[" & Date & " " & Time & "] " & _
                ": folder = " & folderName & _
                "; subject = " & mItem.Subject & "..."

 mItem.Move olDestFolder

End Sub