Saving attachments from multiple emails and updating file name

itskoopa

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Let me start by saying that i am a VBA rookie and am trying to learn. I need to be able to download all attachments and embedded images from multiple emails in outlook and save them to a specified folder with a naming convention of Attachmentname_SubjectLine_Email Address_Date of Email. I was able to come across a code that solved 99% of the problem. The VBA script saves all attachments/embedded images and lets me select the destination to save. The only "issue" is that it saves the filename as the attachment name and for compliance reasons, I need it to reference the email, subject line and date of email. I would greatly appreciate any assistance that can be offered.

For additional information, I found the code here: https://gallery.technet.microsoft.co.../Discussions/4

I attempted to embed the code, but I hit a character count limit. I am going to attach the full code to the post in a PDFdocument and include a snippet here:

Code:
Else
                strFolderPath = CGPath(objFolder.Self.Path)
               
                ' /* Go through each item in the selection. */
                For Each objItem In selItems
                    lCountEachItem = objItem.Attachments.Count
                   
                    ' /* If the current item contains attachments. */
                    If lCountEachItem > 0 Then
                        Set atmts = objItem.Attachments
                       
                        ' /* Go through each attachment in the current item. */
                        For Each atmt In atmts
                           
                            ' Get the full name of the current attachment.
                            strAtmtFullName = atmt.FileName
                           
                            ' Find the dot postion in atmtFullName.
                            intDotPosition = InStrRev(strAtmtFullName, ".")
                           
                            ' Get the name.
                            strAtmtName(0) = Left$(strAtmtFullName, intDotPosition - 1)
                            ' Get the file extension.
                            strAtmtName(1) = Right$(strAtmtFullName, Len(strAtmtFullName) - intDotPosition)
                            ' Get the full saving path of the current attachment.
                            strAtmtPath = strFolderPath & atmt.FileName
                           
                            ' /* If the length of the saving path is not larger than 260 characters.*/
                            If Len(strAtmtPath) <= MAX_PATH Then
                                ' True: This attachment can be saved.
                                blnIsSave = True
                               
                                ' /* Loop until getting the file name which does not exist in the folder. */
                                Do While objFSO.FileExists(strAtmtPath)
                                    strAtmtNameTemp = strAtmtName(0) & _
                                                      Format(Now, "_mmddhhmmss") & _
                                                      Format(Timer * 1000 Mod 1000, "000")
                                    strAtmtPath = strFolderPath & strAtmtNameTemp & "." & strAtmtName(1)
                                       
                                    ' /* If the length of the saving path is over 260 characters.*/
                                    If Len(strAtmtPath) > MAX_PATH Then
                                        lCountEachItem = lCountEachItem - 1
                                        ' False: This attachment cannot be saved.
                                        blnIsSave = False
                                        Exit Do
                                    End If
                                Loop
                               
                                ' /* Save the current attachment if it is a valid file name. */
                                If blnIsSave Then atmt.SaveAsFile strAtmtPath
                            Else
                                lCountEachItem = lCountEachItem - 1
                            End If
                        Next
                    End If
                   
                    ' Count the number of attachments in all Outlook items.
                    lCountAllItems = lCountAllItems + lCountEachItem
                Next
            End If
        Else
            MsgBox "Failed to get the handle of Outlook window!", vbCritical, "Error from Attachment Saver"
            blnIsEnd = True
            GoTo PROC_EXIT
        End If
       
    ' /* For run-time error:
    '    The Explorer has been closed and cannot be used for further operations.
    '    Review your code and restart Outlook. */
    Else
        MsgBox "Please select an Outlook item at least.", vbExclamation, "Message from Attachment Saver"
        blnIsEnd = True
    End If
   
PROC_EXIT:
    SaveAttachmentsFromSelection = lCountAllItems
   
    ' /* Release memory. */
    If Not (objFSO Is Nothing) Then Set objFSO = Nothing
    If Not (objItem Is Nothing) Then Set objItem = Nothing
    If Not (selItems Is Nothing) Then Set selItems = Nothing
    If Not (atmt Is Nothing) Then Set atmt = Nothing
    If Not (atmts Is Nothing) Then Set atmts = Nothing
   
    ' /* End all code execution if the value of blnIsEnd is True. */
    If blnIsEnd Then End
End Function

Once again, this is not the full code and just a portion due to the character limit. Please see the attachment for the full code.

Thanks so much for any assistance you can offer!
 

Attachments

  • VBA Attach Script.pdf
    81.8 KB · Views: 60
Similar threads
Thread starter Title Forum Replies Date
D Saving Selected Emails as PDF and saving Attachments Outlook VBA and Custom Forms 6
R Quick Access view in File Explorer when saving attachments Using Outlook 0
N Saving And Deleting Outlook Attachments with Unknown Error Message Outlook VBA and Custom Forms 1
J Saving attachments from specific sender (phone number) to specific folder on hard drive Using Outlook 3
C Saving Outlook attachments and links to attachments with VBA Outlook VBA and Custom Forms 2
O Saving Attachments to folder on disk and adding Initials to end of file name Outlook VBA and Custom Forms 9
T Saving Outlook 2010 email with attachments but read the email without Outlook Using Outlook 2
D Remove extension while saving attachments Using Outlook 1
S Not saving attachments in the Sent Folder Using Outlook 2
D Saving outlook emails in html and attachments Using Outlook 4
T Outlook 2007 alters date when saving attachments, windows 7. Using Outlook 5
R Does not prompt for saving or opening attachments when downloading attachment in Outlook 2007. Using Outlook 3
E Saving Opened attachments in a secure environment (no local drive access) Using Outlook 6
M Saving attachments from OWA Using Outlook 2
G Can you still edit attachments in office 2010 without saving to hard drive? Using Outlook 15
C Saving email including attachments Using Outlook 4
S Automate saving of attachments on new incoming emails Outlook VBA and Custom Forms 3
J Saving Attachments Outlook VBA and Custom Forms 1
I Error saving screenshots in a custom form in outlook 2016, outlook 365 - ok in outlook 2013, outlook 2010 Outlook VBA and Custom Forms 5
M Adding Subject to this Link-Saving VBA Outlook VBA and Custom Forms 5
L Attachment saving and tracking - PLEASE help! Outlook VBA and Custom Forms 5
B Saving items under a folder Using Outlook 3
V Saving attachment from outlook in My Documents Outlook VBA and Custom Forms 14
I Dialog called up multiple times when saving emails from macro Outlook VBA and Custom Forms 2
A saving attachement to folder named the same as rule name Outlook VBA and Custom Forms 0
T Saving all email to file folder in Windows Using Outlook 2
Kevin H Remotely saving emails Using Outlook 1
R Outlook 2010 Modify Style "Do not check spelling or grammar" not saving Outlook VBA and Custom Forms 0
R Outlook Office 365 not saving addresses Using Outlook 0
A Keep color categories when saving vCards Using Outlook 1
P Saving All Messages to the Hard Drive Using VBA Outlook VBA and Custom Forms 5
e_a_g_l_e_p_i question about saving my .pst so I can import it to my Outlook after I build a new system Using Outlook 10
S Editing an email with notes and saving it for record using Macro Outlook VBA and Custom Forms 3
J Outlook 2013 crashes saving VBA & clicking tools | digital signature Outlook VBA and Custom Forms 1
bifjamod Saving sent email to specific folder based on category with wildcard Outlook VBA and Custom Forms 1
N Saving .msg as sent item on send Outlook VBA and Custom Forms 1
erichamion Changes to meeting body not properly saving Outlook VBA and Custom Forms 4
A ItemAdd on Imap Folder get endless loop after saving item Using Outlook 5
T From Field Blank when saving to folder other than Sent items Using Outlook 2
L Outlook DST (Daylight Saving Time) problem Using Outlook 0
F Using Outlook 2007 as an IMAP Mail Station Without Saving Data Locally Using Outlook 2
E Saving Changes To Edited E-Mail Received Message Using Outlook 0
D File Lock issue when saving message from Outlook to new folder Using Outlook 1
K Printing & Saving Outlook Contacts Using Outlook 3
S trouble with Outlook 2010 saving sent emails Using Outlook 2
W Default Saving a message as text Using Outlook 2
R Outlook 2007 QAT buttons not saving Using Outlook 2
C Exchange 2003 - Outlook 2003 - Calendar entries saving over each other Using Outlook 2
J Saving Published Outlook Form as msg Using Outlook 1
J Saving recent colors used for fonts in an email? Using Outlook 1

Similar threads

Top