Как автоматически печатать вложения в письме?

Question

Каждый день я получаю сотни писем с вложениями в формате PDF, которые мне нужно распечатать.

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

Как автоматически распечатать вложение в письме с помощью Outlook-vba, а затем удалить это письмо.

Answer 1

Добавить Microsoft Scripting Runtime в ссылки ...

Создать новое правило, затем нажать Применить правило к полученным сообщениям / которое имеет вложение / запустить скрипт

Option Explicit
Public Sub Example(Item As Outlook.MailItem)
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    'Temporary Folder
    Dim TempFldr As String
        TempFldr = Environ("USERPROFILE") & "\Documents\Temp\"
        CreateDir TempFldr

    Dim Atmt As Attachment
    Dim AtmtName As String
    Dim oShell As Object
    Dim Fldr As Object
    Dim FldrItem As Object

    For Each Atmt In Item.Attachments
        AtmtName = TempFldr & Atmt.FileName
        Atmt.SaveAsFile AtmtName

        Set oShell = CreateObject("Shell.Application")
        Set Fldr = oShell.NameSpace(0)
        Set FldrItem = Fldr.ParseName(AtmtName)
            FldrItem.InvokeVerbEx ("print")
    Next Atmt

    'Cleans up
    If Not FSO Is Nothing Then Set FSO = Nothing
    If Not Fldr Is Nothing Then Set Fldr = Nothing
    If Not FldrItem Is Nothing Then Set FldrItem = Nothing
    If Not oShell Is Nothing Then Set oShell = Nothing

End Sub

Private Function CreateDir(FldrPath As String)
    Dim Elm As Variant
    Dim CheckPath As String

    CheckPath = ""
    For Each Elm In Split(FldrPath, "\")
        CheckPath = CheckPath & Elm & "\"

        If Len(Dir(CheckPath, vbDirectory)) = 0 Then
            MkDir CheckPath
            Debug.Print CheckPath & " Folder Created"
        End If

        Debug.Print CheckPath & " Folder Exist"
    Next
End Function