Сохранение вложений либо возвращает ошибку 91, либо не сохраняет

Question

Я пытаюсь настроить макрос в ThisOutlookSession для сохранения вложений в файл.

Ранее я использовал правила и «запускал скрипт», но он не включен для всех пользователей.

Приведенный ниже код либо возвращает ошибку 91 (объект или переменная не задана), либо выполняется без ошибок, но не сохраняется.

Код просматривает подпапку, чтобы сохранить все вложения врасположение основано на предмете.Письма отправляются в подпапку с помощью правила.

Я хочу переименовать вложения на основе ReceivedTime, и я думаю, что именно здесь возникает проблема.Если я использую Msg.ReceivedTime, я получаю ошибку 91.Если я использую Item.ReceivedTime, ошибки не возникает, но файл не сохраняется.

Вот источник, из которого я получил большую часть кода и настроил его.https://www.tachytelic.net/2017/10/how-to-run-a-vba-macro-when-new-mail-is-received-in-outlook/

Private WithEvents folderItems As Outlook.Items

Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set folderItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Operations").Folders("Test").Items
End Sub

Private Sub folderItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim att As Outlook.Attachment
Dim msg As Outlook.MailItem
Dim filepath As String, filedate As String
filepath = "C:\Documents\"
filedate = Format(Item.ReceivedTime, "YYYYMMDD") 'This is the line which I think is the problem. If I do Msg.ReceivedTime, I get 91 error, but if I do Item.ReceivedTime, it does not save
If TypeName(Item) = "MailItem" Then
    If InStr(Item.Subject, "XXX") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "XXX\" & filedate & "_raw.csv"
        Next
   ElseIf InStr(Item.Subject, "YYY") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "YYY\" & filedate & "_raw.xlsx"
        Next
    ElseIf InStr(Item.Subject, "ZZZ") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "ZZZ.csv"
        Next
    End If
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

Моя гипотеза состоит в том, что проблема в ReceivedTime.Если я могу использовать Msg.ReceivedTime, как мне установить переменную?Или, если Item.ReceivedTime указан правильно, то почему он не сохраняется?

Answer 1

Попробуйте следующее

Dim att As Outlook.attachment
Dim msg As Outlook.MailItem
Dim filepath As String, filedate As String

filepath = "C:\Documents\"

If TypeName(Item) = "MailItem" Then
    Set msg = Item
    Debug.Print msg.ReceivedTime ' print on Immediate Window
    filedate = Format(msg.ReceivedTime, "YYYYMMDD")

    If InStr(msg.Subject, "XXX") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "XXX\" & filedate & "_raw.csv"
        Next
   ElseIf InStr(msg.Subject, "YYY") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "YYY\" & filedate & "_raw.xlsx"
        Next
    ElseIf InStr(msg.Subject, "ZZZ") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "ZZZ.csv"
        Next
    End If
End If

, также вам не нужно outlookApp, когда код работает в приложении Outlook, просто используйте приложение.

Пример

Private Sub Application_Startup()
  Dim objectNS As Outlook.NameSpace

  Set objectNS = Application.GetNamespace("MAPI")
  Set folderItems = objectNS.GetDefaultFolder(olFolderInbox) _
                            .Folders("Operations") _
                            .Folders("Test").Items
End Sub