Consulting

Results 1 to 12 of 12

Thread: Print all attachments from new mails that are moved into specific folder

  1. #1

    Print all attachments from new mails that are moved into specific folder

    Hi all.

    Hoping someone can help me out here. I have a rule set up so specific mails get auto sent to a folder named Print. What I am trying to do now is to set a vba script that will monitor the folder "Print" and in turn print all emails that are sent to this folder. Preferably, I'd like the script to print out only the attachments or any jpg, png, tif or gif files that are in the email to avoid wasting paper.

    So far I have found this script which errors on me when I try and load it. Subsequently, when I receive anything that matches my rule, it gets sent to the Print folder but nothing happens:
    ''From here starts the function to print anything added to the specified folder.
    Public WithEvents objSpecificFolder As Outlook.Folder
    Public WithEvents objItems As Outlook.Items
    
    
    Private Sub Application_Startup()
        'Specify the folder
        'You can change it as per your needs
        Set objSpecificFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Print")
        Set objItems = objSpecificFolder.Items
    End Sub
    
    
    'Macro works when new item lands into the specific folder
    Private Sub objItems_ItemAdd(ByVal Item As Object)
        Dim objMail As Outlook.MailItem
    
    
        If TypeOf Item Is MailItem Then
           Set objMail = Item
           'Print this mail
           objMail.PrintOut
        End If
    End Sub
    
    'Above this line ends the printing of files added to specified folder
    Could anyone help me out?

  2. #2
    In order to print the attachments, you will need an application capable of printing the images, which Outlook cannot do. Windows Paint is a possibility and you should have that so ...
    The macro which can be run from a rule saves the images into the User's Temp folder then prints the images that are attachments. The macro includes a line to exclude images that are in the message body (which could include the signature logos). If you are sure that you want to print those images also then remove the line
    If Not olAttach.fileName Like "image*.*" Then
    and its associated End If.

    Frankly I don't see this saving much paper as all the images will be printed to separate sheets.

    Sub TestPrint()
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        PrintAttachments olMsg
    lbl_Exit:
        Exit Sub
    End Sub
    
    
    Private Sub PrintAttachments(olItem As MailItem)
    'Graham Mayor - http://www.gmayor.com - Last updated - 08 Mar 2018
    Dim olAttach As Attachment
    Dim strFname As String
    Dim strExt As String
    Dim j As Long
    Dim strSaveFldr As String
        strSaveFldr = Environ("TEMP") & "\"
        On Error GoTo lbl_Exit
        If olItem.Attachments.Count > 0 Then
            For j = 1 To olItem.Attachments.Count
                Set olAttach = olItem.Attachments(j)
                If Not olAttach.fileName Like "image*.*" Then
                    strFname = olAttach.fileName
                    strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                    Select Case LCase(strExt)
                        Case Is = "tif", "jpg", "png", "gif"
                            olAttach.SaveAsFile strSaveFldr & strFname
                            Shell "cmd /c mspaint /p " & strSaveFldr & strFname
                        Case Else
                    End Select
                End If
            Next j
            olItem.Save
        End If
    lbl_Exit:
        Set olAttach = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Quote Originally Posted by gmayor View Post
    In order to print the attachments, you will need an application capable of printing the images, which Outlook cannot do. Windows Paint is a possibility and you should have that so ...
    The macro which can be run from a rule saves the images into the User's Temp folder then prints the images that are attachments. The macro includes a line to exclude images that are in the message body (which could include the signature logos). If you are sure that you want to print those images also then remove the line
    Thanks for taking the time to reply.

    I forgot to mention that due to Group Policy implemented by IT, our notebooks have seen the "run script" option removed from Outlook, as can be seen here.

    https://i.imgur.com/TZh0DCJ.png

    Using the "print it" option prints out everything, including some hefty email bodies that are useless to me.

  4. #4
    I said it CAN be run from a rule, not that it MUST be. The test macro runs the main macro on a selected message. You could loop through a folder and run the code on all the messages in that folder (or all that meet certain criteria) or you can call it from your item add function.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Quote Originally Posted by gmayor View Post
    I said it CAN be run from a rule, not that it MUST be. The test macro runs the main macro on a selected message. You could loop through a folder and run the code on all the messages in that folder (or all that meet certain criteria) or you can call it from your item add function.
    I confess that what you are saying sounds lovely... Unfortunately I do not speak fluent VBA.

    Let me try and wrap my head around it. So I'd have to somehow change the code so that it looks only at files coming into my Print folder and the triggers the print?

  6. #6
    Replace the code in the ThisOutlookSession module with

    Option Explicit
    
    Private WithEvents objItems As Outlook.Items
    
    Private Sub Application_Startup()
    Dim objNS As Outlook.NameSpace
    Dim objWatchFolder As Outlook.Folder
    
        Set objNS = Application.GetNamespace("MAPI")
        Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox).folders("Print")
    
        Set objItems = objWatchFolder.Items
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub objItems_ItemAdd(ByVal Item As Object)
        If TypeOf Item Is Outlook.MailItem Then
            PrintAttachments Item
        End If
    lbl_Exit:
        Exit Sub
    End Sub
    Put the code from my previous message in an ordinary VBA module that you will have to insert i.e.

    Option Explicit
    
    
    Public Sub PrintAttachments(olItem As MailItem)
    'Graham Mayor - http://www.gmayor.com - Last updated - 08 Mar 2018
    Dim olAttach As Attachment
    Dim strFname As String
    Dim strExt As String
    Dim j As Long
    Dim strSaveFldr As String
        strSaveFldr = Environ("TEMP") & "\"
        On Error GoTo lbl_Exit
        If olItem.Attachments.Count > 0 Then
            For j = 1 To olItem.Attachments.Count
                Set olAttach = olItem.Attachments(j)
                If Not olAttach.fileName Like "image*.*" Then
                    strFname = olAttach.fileName
                    strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                    Select Case LCase(strExt)
                        Case Is = "tif", "jpg", "png", "gif"
                            olAttach.SaveAsFile strSaveFldr & strFname
                            Shell "cmd /c mspaint /p " & strSaveFldr & strFname
                        Case Else
                    End Select
                End If
            Next j
            olItem.Save
        End If
    lbl_Exit:
        Set olAttach = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    Run the macro Application_Startup manually or restart Outlook (don't forget to save the project) and move a message with an image attachment into they Print subfolder of the default Inbox.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Quote Originally Posted by gmayor View Post
    Run the macro Application_Startup manually or restart Outlook (don't forget to save the project) and move a message with an image attachment into they Print subfolder of the default Inbox.
    Getting the following error when running or starting
    2018-03-08 18_25_39-Clipboard.jpg

  8. #8
    It looks like you have scrolled the module to enable that to be seen, which suggests you have more code above it. The code I posted should be at the top of the ThisOutlookSession module and should not duplicate any code already in that module,
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Quote Originally Posted by gmayor View Post
    It looks like you have scrolled the module to enable that to be seen, which suggests you have more code above it. The code I posted should be at the top of the ThisOutlookSession module and should not duplicate any code already in that module,
    You are correct. Moving the script to the top did solve the error but I got another one. I searched around and this one seems to pertain to the folder path. I have tried creating a folder at the root of my mailbox named Print and another inside my "Folders" folder also named Print.

    I gather I have the folder in the wrong place. Trying to solve it.
    2018-03-09 11_00_03-Microsoft Visual Basic.jpg2018-03-09 11_02_52-Microsoft Visual Basic for Applications - VbaProject.OTM [break] - [ThisOutl.jpg2018-03-09 11_05_49-Folders - nuno.marques@bitzer.pt - Outlook.jpg2018-03-09 11_07_24-Folders - nuno.marques@bitzer.pt - Outlook.jpg

  10. #10
    Do yuou have a folder called Inbox? Print should be a sub folder of Inbox
    objNS.GetDefaultFolder(olFolderInbox).folders("Print")
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    Quote Originally Posted by gmayor View Post
    Do yuou have a folder called Inbox? Print should be a sub folder of Inbox
    objNS.GetDefaultFolder(olFolderInbox).folders("Print")
    My inbox is in Portuguese although my Office and Outlook is setup for english. Hence it reads "A Receber". I think it's a locale issue. However, creating a Print folder under that solved the error.

    And the result, dear sir, is nothing short of God damn forking brilliant! Who da man?! YOU da man!!!

    That's great stuff. Thanks so much.

  12. #12
    I have been tinkering with the code. I added a different image viewer as the print application. And I am trying to get other formats to print like pdf. Image prints perfectly. PDF won't print at all. Running over the script I don't think you limited printing to just image files. Any idea why PDF won't print?

    'This is the module for the auto print function. It relies also on a part in the ThisOutlookSession.Option Explicit
    
    
    
    
    Public Sub PrintAttachments(olItem As MailItem)
    'Graham Mayor - http://www.gmayor.com - Last updated - 08 Mar 2018
    Dim olAttach As Attachment
    Dim strFname As String
    Dim strExt As String
    Dim j As Long
    Dim strSaveFldr As String
        strSaveFldr = Environ("TEMP") & "\"
        On Error GoTo lbl_Exit
        If olItem.Attachments.Count > 0 Then
            For j = 1 To olItem.Attachments.Count
                Set olAttach = olItem.Attachments(j)
                If Not olAttach.FileName Like "image*.*" Then
                    strFname = olAttach.FileName
                    strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                    Select Case LCase(strExt)
                        'Case Is = "tif", "jpg", "png", "gif"
                        '    olAttach.SaveAsFile strSaveFldr & strFname
                        '    'Shell "cmd /c mspaint /p " & strSaveFldr & strFname
                        '    Shell "cmd /c D:\work\PortableApps\PortableApps\IrfanViewPortable\App\IrfanView\i_view32.exe " & strSaveFldr & strFname & " /print"
                        'Case Else
                        'Changes start
                        Case Is = "tif", "jpg", "png", "gif"
                            olAttach.SaveAsFile strSaveFldr & strFname
                            Shell "D:\work\PortableApps\PortableApps\IrfanViewPortable\App\IrfanView\i_view32.exe " & strSaveFldr & strFname & " /print"
                        Case Is = "pdf"
                            olAttach.SaveAsFile strSaveFldr & strFname
                            Shell "D:\work\PDFtoPrinter\PDFtoPrinter.exe" & strSaveFldr & strFname
                        Case Else
                        'Changes end
                    End Select
                End If
            Next j
            olItem.Save
        End If
    lbl_Exit:
        Set olAttach = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    Edit: Nevermind. Being the idiot that I am, I forgot to leave a space after the executable.
    Shell "D:\work\PDFtoPrinter\PDFtoPrinter.exe " & strSaveFldr & strFname
    That fixed it. Great stuff.
    Last edited by nmgmarques; 03-09-2018 at 12:34 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •