Outlook Auto printing multiple attachments

问题

For some reason this is only printing the first attachment in the e-mail. It doesn't seem like my for loop is working. Any clue? Basically it saves a backup of the attachments, prints the e-mail, prints the .pdf attachment, and then categorizes it as "printed". I need it do it for every .pdf on the e-mail. Not just the first one that is attached.

 Private Declare PtrSafe 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
Option Compare Text
Sub PrintAttachments(oMail As Outlook.MailItem)
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
Dim strSubject As String

strSubject = oMail.Subject
sDirectory = "MYDIRISHERE"
Set colAtts = oMail.Attachments
If colAtts.Count Then
    For Each oAtt In colAtts
        sFileType = LCase$(Right$(oAtt.FileName, 4))
        Select Case sFileType
        ' Add additional file types below followed by comma
        Case ".pdf"
            If oMail.Categories <> "Printed" Then
                sFile = sDirectory & oAtt.FileName & " " & strSubject & sFileType
                oAtt.SaveAsFile sFile
                oMail.PrintOut
                oMail.Categories = "Printed"
                oMail.Save
                ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                Debug.Print "Email " & strSubject & " with attachment " & oAtt.FileName & " from " & oMail.SenderName & " Printed."
             End If
        Case Else
            Debug.Print "Attachment: " & oAtt.FileName & " from " & oMail.SenderName & " is not authorized to print."
        End Select
    Next oAtt
End If
End Sub

回答1:

Check the category at the start so "Not Printed" remains in force until all attachments are processed.

Private Declare PtrSafe 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

Option Compare Text

Sub PrintAttachments(oMail As MailItem)

Dim colAtts As Attachments
Dim oAtt As Attachment

Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
Dim strSubject As String

strSubject = oMail.Subject
sDirectory = "MYDIRISHERE"

If oMail.Categories <> "Printed" Then

    Set colAtts = oMail.Attachments

    If colAtts.Count Then
        For Each oAtt In colAtts
            sFileType = LCase$(Right$(oAtt.FileName, 4))
            Select Case sFileType

            ' Add additional file types below followed by comma
            Case ".pdf"

                ' This stops the second and subsequent attachments
                '  from being printed since 
                '  the category is prematurely set to "Printed".
                ' If oMail.Categories <> "Printed" Then

                    sFile = sDirectory & oAtt.FileName & " " & strSubject & sFileType
                    oAtt.SaveAsFile sFile
                    oMail.PrintOut
                    oMail.Categories = "Printed"
                    oMail.Save
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                    Debug.Print "Email " & strSubject & " with attachment " & oAtt.FileName & " from " & oMail.SenderName & " Printed."

                 ' End If

            Case Else
                Debug.Print "Attachment: " & oAtt.FileName & " from " & oMail.SenderName & " is not authorized to print."

            End Select
        Next oAtt
    End If

End If

End Sub

来源：https://stackoverflow.com/questions/49633535/outlook-auto-printing-multiple-attachments

标签

vba

outlook-vba