Consulting

Results 1 to 13 of 13

Thread: Outlook attachment save & print

  1. #1
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location

    Outlook attachment save & print

    Hello everyone,
    I need help on the following Micro, it works but I need to add a second email address that needs to be saved in same directory and print as they arrive. Thank you


    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
     Private WithEvents Items As Outlook.Items
     Private Sub Application_Startup()
        Dim Ns As Outlook.NameSpace
        Dim Folder As Outlook.MAPIFolder
    
        Set Ns = Application.GetNamespace("MAPI")
        Set Folder = Ns.GetDefaultFolder(olFolderInbox)
        Set Items = Folder.Items
     End Sub
     Private Sub Items_ItemAdd(ByVal Item As Object)
        If TypeOf Item Is Outlook.MailItem Then
    PrintAttachments Item
        End If
     End Sub
     Private Sub PrintAttachments(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
    
        ' Save attachments to
    sDirectory = "C:\Attachments\"
        Set colAtts = oMail.Attachments
        ' email address attachment that needs to be saved
        If colAtts.Count And oMail.SenderEmailAddress ="email address here" Then
                For Each oAtt In colAtts
    
            'The code looks at the last 4 characters,
            'including the period and will work as long as you use 4 characters in each extension we want to check.
    sFileType = LCase$(Right$(oAtt.FileName, 4))
    
                Select Case sFileType
            ' Add additional file types below
                Case "xlsx", "docx", ".pdf", ".doc", ".xls"
    
    sFile = sDirectory & oAtt.FileName
    oAtt.SaveAsFile sFile
                    'Print saved attachements
    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                End Select
            Next
        End If
     End Sub

  2. #2
    Add another condition as shown below

    If colAtts.Count Then
            If oMail.SenderEmailAddress = "email address here" Or _
               oMail.SenderEmailAddress = "another email address here" Then
                For Each oAtt In colAtts
    
                    'The code looks at the last 4 characters,
                    'including the period and will work as long as you use 4 characters in each extension we want to check.
                    sFileType = LCase$(Right$(oAtt.Filename, 4))
    
                    Select Case sFileType
                            ' Add additional file types below
                        Case "xlsx", "docx", ".pdf", ".doc", ".xls"
    
                            sFile = sDirectory & oAtt.Filename
                            oAtt.SaveAsFile sFile
                            'Print saved attachements
                            ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                    End Select
                Next
            End If
        End If
    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
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location
    Perfect. Thank you thank you it worked

  4. #4
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location
    hi again.. Is it possible to assign each email to separate folder to save before it prints.

  5. #5
    Probably, what did you have in mind?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location
    I don't know how to do that, I was thinking email 1 be saved on folder 1 then print, email 2 be saved on folder 2 then print.

  7. #7
    You missed the point of my question. Where do you want to save the messages? How is it determined what Folder1 and Folder2 are? Are they Outlook folders or Windows filing system folders? If the former you can use rules to do that. If the latter you must bear in mind what to do about duplicate filenames.
    Also is it the messages that you want to print now or the attachments? You later message suggest the former whereas the thread was originally about the latter.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  8. #8
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location
    sorry bro, I want to save and print attachments only.
    right now I am working only with 2 email address but I don't want to save both email attachments on the same directory ("C:\Attachments\")
    email-one to be saved on "C:\folder1\"
    email-two to be saved on "C:\folder2\"

    Thanks gmayor.

  9. #9
    OK, in that case replace the section with the following, which I think should do the job
    If colAtts.Count Then
        Select Case oMail.SenderEmailAddress
            Case "email address here"
                sDirectory = "C:\Path\Folder1\"
            Case "another email address here"
                sDirectory = "C:\Path\Folder2\"
            Case Else: Exit Sub
        End Select
        For Each oAtt In colAtts
            'The code looks at the last 4 characters,
            'including the period and will work as long as you use 4 characters in each extension we want to check.
            sFileType = LCase$(Right$(oAtt.Filename, 4))
    
            Select Case sFileType
                    ' Add additional file types below
                Case "xlsx", "docx", ".pdf", ".doc", ".xls"
    
                    sFile = sDirectory & oAtt.Filename
                    oAtt.SaveAsFile sFile
                    'Print saved attachements
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  10. #10
    VBAX Regular Omer's Avatar
    Joined
    Feb 2015
    Location
    Houston
    Posts
    27
    Location
    great its working, thanks again. Graham

  11. #11

    File extension with more than one dot

    Hi,
    i´v been using the vba code below with sucess. however an issue ocourred. if i receive a file with more than one dot ex: 1.23.pdf the vba code does note recocnize it as a pdf file, and doe not print it. iv tried add aditional file extension but no sucess. can you please help me?
    of corse if i rename the file it works but its nott a solution for me

    Thans in advance

    Carlos Pires




    Quote Originally Posted by gmayor View Post
    OK, in that case replace the section with the following, which I think should do the job
    If colAtts.Count Then
        Select Case oMail.SenderEmailAddress
            Case "email address here"
                sDirectory = "C:\Path\Folder1\"
            Case "another email address here"
                sDirectory = "C:\Path\Folder2\"
            Case Else: Exit Sub
        End Select
        For Each oAtt In colAtts
            'The code looks at the last 4 characters,
            'including the period and will work as long as you use 4 characters in each extension we want to check.
            sFileType = LCase$(Right$(oAtt.Filename, 4))
    
            Select Case sFileType
                    ' Add additional file types below
                Case "xlsx", "docx", ".pdf", ".doc", ".xls"
    
                    sFile = sDirectory & oAtt.Filename
                    oAtt.SaveAsFile sFile
                    'Print saved attachements
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If

  12. #12
    Hi,
    i´v been using the vba code below with sucess. however an issue ocourred. if i receive a file with more than one dot ex: 1.23.pdf the vba code does note recocnize it as a pdf file, and doe not print it. iv tried add aditional file extension but no sucess. can you please help me?
    of corse if i rename the file it works but its nott a solution for me

    Thans in advance

    Carlos Pires

  13. #13
    It works here, unless the PDF file is protected against printing.

    Try the following variation - and if it is the extra period that is causing the problem, remove the apostrophe that is blocking the line
    sFile = Replace(Left(sFile, Len(sFile) - Len(sFileType)), Chr(46), "_") & sFileType
    Private Sub PrintAttachments(oMail As Outlook.MailItem)
    
    
        On Error Resume Next
        Dim olAtts As Outlook.Attachments
        Dim oAtt As Outlook.Attachment
        Dim i As Long
        Dim sFile As String
        Dim sDirectory As String
        Dim sFileType As String
    
    
        Set olAtts = oMail.Attachments
    
    
        If olAtts.Count > 0 Then
            Select Case oMail.SenderEmailAddress
                Case "emailaddress1"
                    sDirectory = "C:\Path\Folder1\"
                Case "emailaddress2"
                    sDirectory = "C:\Path\Folder2\"
                Case Else: Exit Sub
            End Select
        End If
    
    
        For i = olAtts.Count To 1 Step -1
            Set oAtt = olAtts(i)
            sFile = olAtts(i).fileName
            sFileType = Right(sFile, Len(sFile) - InStrRev(sFile, Chr(46)) + 1)
            Select Case sFileType
                Case ".xlsx", ".docx", ".pdf", ".doc", ".xls"
                    sFile = oAtt.fileName
                    'sFile = Replace(Left(sFile, Len(sFile) - Len(sFileType)), Chr(46), "_") & sFileType
                    sFile = sDirectory & sFile
                    oAtt.SaveAsFile sFile
                    ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
        Next i
        Set oAtt = Nothing
        Set olAtts = Nothing
    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

Posting Permissions

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