Код не выполняется при перемещении по правилу входящих

Question

У меня есть несколько ежедневных отчетов (файлы Excel), которые отправляются мне по электронной почте. Правило папки «Входящие» перемещает электронную почту в папку Outlook с заголовком «Ежедневные отчеты»

. Когда правило перемещается в папку по правилу, я хочу, чтобы вложения автоматически сохранялись в папке и сортировались по дате. Примерно так: C: \ Desktop \ ReportName \ 2019 \ 11-2019 \ 11-05-2019 Имя отчета.xlsx

Однако у меня возникла пара проблем.

1. Код не запускается, когда правило перемещает электронную почту, только когда я вручную перемещаю электронную почту.
2. Он просто создает новые каталоги и сохраняет первое вложение электронных писем, однако дополнительные письма дают ошибку пути / доступа, ссылающуюся на эту строку "MkDir (" C: \ Users \ username \ Desktop \ Outlook Test Folder \ "&Формат (Дата, "ГГГГ")) "

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    Dim objNS As Outlook.NameSpace

    Set objNS = GetNamespace("MAPI")
    Set olItems = objNS.GetDefaultFolder(olFolderInbox).Parent.Folders("Daily Reports").Items
    Set objNS = Nothing
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewMail As Outlook.MailItem
    Dim Atts As Attachments
    Dim strPath As String
    Dim attName As String

    If Item.Class = olMail Then
        Set NewMail = Item
    End If

    If Dir("C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY"), vbDirectory) = "" Then
        MkDir ("C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY"))
    End If

    If Dir("C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY" & "\" & Format(Date, "MM-YYYY")), vbDirectory) = "" Then
        MkDir ("C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY") & "\" & Format(Date, "MM-YYYY"))
    End If

    If InStr(LCase(Item.Subject), "daily applications was executed at") > 0 Then
       strPath = "C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY") & "\" & Format(Date, "MM-YYYY")
       attName = " Daily Applications.Xlsx"
    ElseIf InStr(LCase(Item.Subject), "dailyopenedcalls was executed at") > 0 Then
            strPath = "C:\Users\username\Desktop\Outlook Test Folder\" & Format(Date, "YYYY") & "\" & Format(Date, "MM-YYYY")
            attName = " Daily Opened Calls.Xlsx"
    End If

    Set Atts = Item.Attachments

    If Atts.Count > 0 Then
        For Each Att In Atts
            If InStr(LCase(Att.FileName), ".xlsx") > 0 Then
                Att.SaveAsFile strPath & "\" & Format(Date, "mm-dd-yyyy") & attName
            End If
        Next
    End If

End Sub
```

Answer 1

1. Код не запускается, когда правило перемещает электронную почту, только когда я перемещаю ее вручную.

Если несколько элементов перемещаются в папку,событие ItemAdd не может быть запущено. Это известная проблема в Outlook.

Другая возможная причина заключается в том, что правило Outlook запускается до Application_Startup.

Он просто создает новые каталоги и сохраняет первое вложение электронных писем, однако дополнительные письма дают ошибку пути / доступа

Убедитесь, что вы используете символы, разрешенные в пути или файлах. Я бы предложил создать один и тот же путь вручную, чтобы в нем использовались только разрешенные символы.