Сценарии Outlook VBA - печать вложений и перемещение писем

Question

Я новичок в VB-скриптинге, поэтому мне нужна большая помощь.

Недавнее изменение учетной записи электронной почты означает, что полученные электронные письма перемещаются в папку, отличную от папки «Входящие», по правилу, в которое я не ввел и не могу изменить, назовем его Folder_X.

Я пытаюсь автоматически печатать вложения из любого письма, которое приходит в Folder_X с вложением. Как только вложение будет напечатано, переместите письмо в другую папку (Папка_Y). Любое письмо, которое не имеет вложения, не должно быть перемещено.

Ранее я мог использовать правило для входящей почты, перемещая его в папку Folder_Y, если у него было вложение, и запустив следующий скрипт, который я нашел в Интернете для печати вложения. Но с этой новой настройкой правила, в которую я не имею ввода, я больше не могу использовать предыдущее правило, поскольку правила работают только с входящей / исходящей почтой, а не с почтой, уже находящейся в папке (Folder_X).

Sub LSPrint(Item As Outlook.MailItem)
    On Error GoTo OError

    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String

    Set oFS = New FileSystemObject
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
    'creates a special temp folder
    cTmpFld = sTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)

    'save & print
    Dim oAtt As Attachment

    For Each oAtt In Item.Attachments
      FileName = oAtt.FileName
      FullFile = cTmpFld & "\" & FileName

      'save attachment
      oAtt.SaveAsFile (FullFile)

      'print attachment
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.NameSpace(0)
      Set objFolderItem = objFolder.ParseName(FullFile)
      objFolderItem.InvokeVerbEx ("print")
    Next oAtt

    'Cleanup

    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing

OError:

    If Err <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Err.Clear
    End If

    Exit Sub
End Sub

Будем весьма благодарны за любые предложения о том, как адаптировать этот скрипт для работы с папкой или альтернативный способ сделать это.

Answer 1

Вы можете использовать событие ItemAdd для запуска кода после того, как элемент входит в папку.

Option Explicit

'  In ThisOutlookSession
Private WithEvents addedItems As Items

Private Sub Application_Startup()
    ' Add as many  .folders(subfolder name) as is needed to navigate to the folder
    Set addedItems = Session.GetDefaultFolder(olFolderInbox).folders("folder_X").Items
End Sub

Private Sub addedItems_ItemAdd(ByVal Item As Object)

    Dim oAtt As attachment

    If Item.Attachments.count > 0 Then

        Debug.Print "Processing " & Item.subject

        For Each oAtt In Item.Attachments
            Debug.Print "Processing attachment."
        Next oAtt

        Item.move Session.GetDefaultFolder(olFolderInbox).folders("folder_Y")

    End If

End Sub