收到新电子邮件时不运行规则答案

【问题标题】：Rule does not run when a new email comes in收到新电子邮件时不运行规则
【发布时间】：2014-02-22 18:12:52
【问题描述】：

我编写了以下代码，以根据主题行将附件保存到电子邮件、映射的网络驱动器中。但是 Outlook 2010 (xp OS) 中的规则在收到新电子邮件时不起作用。它不会将其保存到指定位置。当我手动运行规则时，效果很好。

我已启用所有宏。重新启动 Outlook 没有变化。我在运行时提示了宏。当有新邮件进来时它会提示。我点击启用不保存，没有错误，它没有保存。

Public Sub SaveAttachments2(mail As Outlook.MailItem)
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim f As String
Dim strSubject As String
Dim w As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

For Each Item In Inbox.Items
   strSubject = Item.Subject
    f = strSubject
    Rem MkDir ("Z:\OPERATIO\AS400_Report\" & f)
    For Each Atmt In Item.Attachments
        FileName = "Z:\OPERATIO\AS400_Reports\" & f & "\" & Atmt.FileName
        Atmt.SaveAsFile FileName
        i = i + 1


    'commented out and added rule option to delete the item
    Next Atmt
    'Item.Delete

    GetAttachments_exit:
     Set Atmt = Nothing
     Set Item = Nothing
     Set ns = Nothing
     Exit Sub

    GetAttachments_err:
     MsgBox "An unexpected error has occurred." _
     & vbCrLf & "Please note and report the following information." _
     & vbCrLf & "Macro Name: SaveAttachments2" _
     & vbCrLf & "Error Number: " & Err.Number _
     & vbCrLf & "Error Description: " & Err.Description _
     , vbCritical, "Error!"
     Resume GetAttachments_exit
    'added next because of compile error
    Next
    End Sub

【问题讨论】：

标签： vba outlook rules

【解决方案1】：

您不能通过简单地添加 (mail As Outlook.MailItem) 来更改独立 VBA。

Public Sub SaveAttachments2(mail As Outlook.mailItem)

    Dim Atmt As attachment
    Dim FileName As String
    Dim f As String

    f = Trim(mail.Subject) ' Removes spaces at ends. This is a big problem.

    On Error Resume Next
    MkDir ("Z:\OPERATIO\AS400_Report\" & f) ' Creates a folder if it does not exist

    On Error GoTo GetAttachments_err

    For Each Atmt In mail.Attachments
       FileName = "Z:\OPERATIO\AS400_Reports\" & f & "\" & Atmt.FileName

        Atmt.SaveAsFile FileName
        ' Fails on subjects with illegal characters.
        ' For example when RE: and FW: in the subject the folder cannot be created.

    Next Atmt

GetAttachments_exit:
     Exit Sub

GetAttachments_err:
     MsgBox "An unexpected error has occurred." _
     & vbCrLf & "Please note and report the following information." _
     & vbCrLf & "Macro Name: SaveAttachments2" _
     & vbCrLf & "Error Number: " & Err.Number _
     & vbCrLf & "Error Description: " & Err.Description _
     , vbCritical, "Error!"
     Resume GetAttachments_exit

End Sub

如果非法字符导致创建文件夹出现问题，请查看此处。 Save mail with subject as filename

【讨论】：