Сохраните и распечатайте заархивированный файл автоматически - PullRequest
Новая
       5

Сохраните и распечатайте заархивированный файл автоматически

0 голосов
/ 16 января 2020

Я использую Outlook VBA-Script для печати вложений, если вложение является PDF-файлом.

Если вложение является zip-файлом, сценарий сохраняет его в указанной папке на моем компьютере. Однако содержимое ZIP-файла необходимо сначала распаковать, а затем распечатать вручную, что очень раздражает при большом объеме электронной почты. 

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Public Sub PrintSelectedAttachments_Modul1()
    Dim Exp As Outlook.Explorer
    Dim Sel As Outlook.Selection
    Dim obj As Object

    Set Exp = Application.ActiveExplorer
    Set Sel = Exp.Selection

    For Each obj In Sel
        If TypeOf obj Is Outlook.MailItem Then
            PrintAttachments_Modul1 obj
        End If
    Next
End Sub


Private Sub PrintAttachments_Modul1(oMail As Outlook.MailItem)
    On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim oAtt As Outlook.Attachment
    Dim sFile As String
    Dim sDirectory As String
    Dim sFileType As String

    sDirectory = "C:\Temp\Rechnungen\Outlook\"

    Set colAtts = oMail.Attachments

    If colAtts.Count Then
        For Each oAtt In colAtts
            sFileType = LCase$(Right$(oAtt.FileName, 4))
            Select Case sFileType
            Case ".xls", ".doc", ".pdf"
                sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
                oAtt.SaveAsFile sFile
                ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If
End Sub


Public Sub SaveAttachments_ZIP()

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Objekt
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Specify path
strFolderpath = "C:\Temp\Rechnungen\Outlook\"
On Error Resume Next

Set objOL = CreateObject("Outlook.Application")

Set objSelection = objOL.ActiveExplorer.Selection

For Each objMsg In objSelection
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then
        For i = lngCount To 1 Step -1

            ' Read filename
            strFile = objAttachments.Item(i).FileName

            ' Merge
            strFile = strFolderpath & strFile

            ' Save file
            objAttachments.Item(i).SaveAsFile strFile

        Next i
    End If

Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Возможно ли изменить этот скрипт как следующее?:

  1. Проверить вложение в почте: если PDF, то сохранить на локальном компьютере

иначе

1.2. Проверьте наличие ZIP-файла в почте: если ZIP-файл, то распакуйте его и сохраните разархивированные файлы на локальном компьютере

Затем распечатайте все сохраненные файлы на стандартном принтере
...