Consulting

Results 1 to 4 of 4

Thread: Outlook VBA Save Email Attachments with Received Time and Sender Name

  1. #1

    Outlook VBA Save Email Attachments with Received Time and Sender Name

    Hi Everyone,

    Goal: My goal is to have a macro that saves all emails attachments to a specific folder on emails that I have selected in my Outlook.

    What I have tried: I have code, see below, that works great but....when I have multiple attachments with the same file name the macro only saves one of the attachments.
    For example, I will have multiple attachments called "image.pdf" but it only saves one attachment with that name and file type. I have been researching this for weeks and have tried a few different methods but none have worked for my needs or worked at all.

    Microsoft Version: Outlook 365


    How my code works: How my code works is it saves email attachments to a specific folder on emails that I have selected in Outlook. It involves two macros. The macro called "Save_Emails_TEST" finds the folder I have designated and then calls on the "SaveAttachments" macro that actually saves the attachments.

    My request is this. Can someone please help me add code to my existing code. I would like this code to add the received date and time, senders' name, and original file name as the new file name for the files that are saved in my external folder.

    Thank you in advance!
    Ryan

    Public Sub Save_Emails_TEST()strFolderpath = "H:\Saved Email Attachments\Test"
    SaveAttachments
    End Sub
    
    
    Private Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    
    
        On Error Resume Next
        Set objOL = Application
    
    
        Set objSelection = objOL.ActiveExplorer.Selection
    
    
        ' Check each selected item for attachments.
        For Each objMsg In objSelection
    
    
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.count
            
        If lngCount > 0 Then
        
        ' Use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.
        
        For i = lngCount To 1 Step -1
        
        ' Get the file name.
        strFile = objAttachments.Item(i).FileName
        
        ' Combine with the path to the folder.
        strFile = strFolderpath & strFile
        
        ' Save the attachment as a 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
    Last edited by AlbinoRyno88; 07-21-2021 at 07:10 AM. Reason: Changing code to look like vba text

  2. #2
    The following will add the name and time, however that creates problems of its own because of illegal filename characters, so the date and time should be formatted as "yyyyMMdd_hhmm"and the sender name must be checked to eliminate illegal characters. Note also that the path should be terminated with the folder separator character and must exist unless you add code to create it if missing.

    Option Explicit
    
    'Updated 22 July 2021 by Graham Mayor - https://www.gmayor.com
    
    Public Sub SaveAttachments()
    Const strFolderpath As String = "H:\Saved Email Attachments\Test\"
    
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
        On Error Resume Next
        Set objOL = Application
        Set objSelection = objOL.ActiveExplorer.Selection
        ' Check each selected item for attachments.
        For Each objMsg In objSelection
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                ' Use a count down loop for removing items
                ' from a collection. Otherwise, the loop counter gets
                ' confused and only every other item is removed.
                For i = lngCount To 1 Step -1
                    ' Get the file name and add received time and sender name.
                    strFile = Format(objMsg.ReceivedTime, "yyyyMMdd_hhmm") & _
                              "_" & objMsg.SenderName & _
                              "_" & objAttachments.Item(i).FileName
                    'Remove illegal filename characters
                    strFile = CleanFileName(strFile)
                    ' Combine with the path to the folder.
                    strFile = strFolderpath & strFile
                    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
    
    Private Function CleanFileName(strFileName As String) As String
    Dim arrInvalid() As String
    Dim lng_Index As Long
        'Define illegal characters (by ASCII CharNum)
        arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
        'Remove any illegal filename characters
        CleanFileName = strFileName
        For lng_Index = 0 To UBound(arrInvalid)
            CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
        Next lng_Index
    lbl_Exit:
        Exit Function
    End Function
    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
    Gmayor, I have seen your work throughout this forum and I was really really hoping you would be the one to help me because if anyone could solve my problem I knew it would be you! IT WORKS PEREFECTLY! How much time did this take you to make this code? I would like to make a donation to your website for your help and time.

    I really appreciate and admire your work. You clearly know what you are doing. Could you recommend any tips, books, resources, or websites that could help someone like me learn VBA coding better? I don't have any computer programing education. I have an accounting background. I am self-taught in VBA thus far. I use VBA forums to try and learn but it’s not as structured as I would like. Basically, I understand enough VBA code to be dangerous haha.

    Again, I appreciate your help Gmayor!

  4. #4
    Thanks for your appreciation. There are plenty of coding examples on my web site and that of my friend Greg Maxey. Others I will let you discover for yourself
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

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