Consulting

Results 1 to 12 of 12

Thread: Macro to Print only selected email attachments

  1. #1

    Macro to Print only selected email attachments

    Heyy, I currently recieve around 100+ emails a day each with one pdf attachment in them. What i would like to be able to do is select the emails with attachments in them and run a macro that will print only the attachment from each email. I do not want the email to be printed only the attachment as having to spend ages each day selecting each individual email an print each pdf one at a time is very time consuming. If i could have some macro code that would allow me to be able to do what im hopeing to accomplish it would be greatly apreciated thanks in advance if you are abler to help me

  2. #2
    Put the messages to process in a sub folder of Inbox and run the macro ProcessFolder below. You can test it by selecting a single message and run the macro ProcessAttachment.

    Option Explicit
    #If Win64 Then
    Public 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
    #Else
    Public 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
    #End If
    
    Sub ProcessAttachment()
    'Graham Mayor - http://www.gmayor.com - Last updated - 02 Sep 2017 Dim olMsg As MailItem
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        PrintAttachments olMsg
    lbl_Exit:
        Set olMsg = Nothing
        Exit Sub
    End Sub
    
    Sub ProcessFolder()
    'Graham Mayor - http://www.gmayor.com - Last updated - 02 Sep 2017
    Dim olNS As Outlook.NameSpace
    Dim olMailFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olMailItem As MailItem
        On Error GoTo err_Handler
        Set olNS = GetNamespace("MAPI")
        Set olMailFolder = olNS.PickFolder
        Set olItems = olMailFolder.Items
        For Each olMailItem In olItems
            PrintAttachments olMailItem
            DoEvents
        End If
    Next olMailItem
    err_Handler:
    Set olNS = Nothing
    Set olMailFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
    lbl_Exit:
    Exit Sub
    End Sub
    
    Private Sub PrintAttachments(olItem As MailItem)
    'Graham Mayor - http://www.gmayor.com - Last updated - 02 Sep 2017
    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 LCase(olAttach.fileName) Like "*.pdf" Then
                    strFname = olAttach.fileName
                    olAttach.SaveAsFile strSaveFldr & strFname
                    NewShell strSaveFldr & strFname, 0
                    DoEvents
                End If
            Next j
        End If
    lbl_Exit:
        Set olAttach = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    
    Private Sub NewShell(cmdLine As String, lngWindowHndl As Long)
        ShellExecute lngWindowHndl, "print", cmdLine, "", "", 0
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Hello and thank you for your reply, The second paragraph from your code after the #else was appearing in red but im assuming that its the same as the top one so i copied and pasted over it and its all blue and black with nothing in red. and at the end. I have named my sub Folder ProcessFolder and tried to run the process folder macro but got a compile error end if without block if under the processfolder macro,

    I then select the emails that i have in that folder and run the process attachment macro and it prints the attachment however it only prints one of the email attachments?
    So it definetly works on printing one email but how can i get it to print the attachments on all selected emails?

  4. #4
    Option Explicit
    #If Win64 Then
        Public 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
    #Else
          Public 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
    #End If
     
    Sub ProcessAttachment()
         'Graham Mayor -  - Last updated - 02 Sep 2017 Dim olMsg As MailItem
        Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        PrintAttachments olMsg
    lbl_Exit:
        Set olMsg = Nothing
        Exit Sub
    End Sub
     
    Sub ProcessFolder()
         'Graham Mayor -  - Last updated - 02 Sep 2017
        Dim olNS As Outlook.NameSpace
        Dim olMailFolder As Outlook.MAPIFolder
        Dim olItems As Outlook.Items
        Dim olMailItem As MailItem
        On Error GoTo err_Handler
        Set olNS = GetNamespace("MAPI")
        Set olMailFolder = olNS.PickFolder
        Set olItems = olMailFolder.Items
        For Each olMailItem In olItems
            PrintAttachments olMailItem
            DoEvents
       
    Next olMailItem
    err_Handler:
    Set olNS = Nothing
    Set olMailFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
    lbl_Exit:
    Exit Sub
    End Sub
     
    Private Sub PrintAttachments(olItem As MailItem)
         'Graham Mayor - - Last updated - 02 Sep 2017
        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 LCase(olAttach.FileName) Like "*.pdf" Then
                    strFname = olAttach.FileName
                    olAttach.SaveAsFile strSaveFldr & strFname
                    NewShell strSaveFldr & strFname, 0
                    DoEvents
                End If
            Next j
        End If
    lbl_Exit:
        Set olAttach = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
     
    Private Sub NewShell(cmdLine As String, lngWindowHndl As Long)
        ShellExecute lngWindowHndl, "print", cmdLine, "", "", 0
    lbl_Exit:
    Exit Sub
    End Sub



    This is what the code in my module currently looks like, the process folder now works however when i have four different emails in my process folder it prints the same one four times? how do i get it to print each one once?

  5. #5
    If the second segment after #Else is shown in red, it suggests that you have the 64 bit version of Outlook and the red is normal in such circumstances as the code in the #Else segment is not compatible with 64 bit, which is why the alternatives are presented. However if you have the 64 bit version it doesn't matter that you have changed it.

    I don't understand what you mean by
    'I have named my sub Folder ProcessFolder and tried to run the process folder macro but got a compile error end if without block if under the processfolder macro,'
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    Just ignore that i got it working (kinda)< when i select the folder from the process folder macro for example if i have two emails in there it prints the first email twice instead of printing them each once can you help me with this? For example: if i have 4 emails in there and run the macro it prints the first email 4 times =[ are you able to help me to get it to print each email once?

  7. #7

  8. #8
    Remove the End If line. I had removed it from the original Reply.
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Yeah i did delete it however when i select the folder from the process folder macro for example if i have two emails in there it prints the first email twice instead of printing them each once can you help me with this? For example: if i have 4 emails in there and run the macro it prints the first email 4 times =[ are you able to help me to get it to print each email once?

  10. #10
    Hmmm. It should work.
    Change the line
    NewShell strSaveFldr & strFname, 0
    to
    Debug.Print strSaveFldr & strFname
    does it list the files in the local window?
    If it does change the line back and
    change the line
    ShellExecute lngWindowHndl, "print", cmdLine, "", "", 0
    to
    ShellExecute lngWindowHndl, "open", cmdLine, "", "", 3
    are all the documents opened in your PDF application?
    If so change open to print and try again.
    As you have indicated you have the 64 bit version of Office I cannot test this. It works as intended here in 32 bit Outlook.
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    For the first part yes the list shows the files in a local window,
    For the Second Part It only opens one of the attachments. =[

  12. #12
    Hi,

    Many thanks for this, it has been a great help for me when printing off large amounts of attachments. However, i recently ran into an issue with it and have been trying to figure a solution for a couple of days now and having no luck.

    Sometimes we receive multiple emails (x) from the same sender with the same attachment names and a different subject (i assume they are automatically sent from their end using a program), when the macro is ran it manages to filter through the emails but prints the same attachment x times.

    For example, if we receive 12 emails from from the same email where the attachments are all different but are all called invoice.pdf, it would print the same attachment 12 times.

    Do you have any ideas on how to get around this, i have tried a couple of ways and seem to have no success.

    Thanks again and appreciate any help that can be given.

Posting Permissions

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