☰

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

tag-icon • tag-icon email microsoft-outlook vba printing
Скрипты Outlook VBA – печать вложений и перемещение писем

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

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

Я пытаюсь сделать автоматическую печать вложений из любого письма, которое приходит в Folder_X, в котором есть вложение. После того, как вложение будет распечатано, переместите письмо в другую папку (Folder_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

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

решение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

Связанный контент