새 이메일이 왔을 때 규칙이 실행되지 않습니다

Question

전자 메일, 연결된 네트워크 드라이브, 제목 줄을 기준으로 첨부 파일을 저장하려면 아래 코드를 작성했습니다. 그러나 새 이메일이 오면 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 

Answer 1

(mail.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