Saving attachments from multiple emails and updating file name

Status
Not open for further replies.

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: 492
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
R Saving Emails and Attachments as .msg file Using Outlook 3
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
S Automate saving of attachments on new incoming emails Outlook VBA and Custom Forms 3
J Saving Attachments Outlook VBA and Custom Forms 1
Rupert Dragwater Background colors not saving in Outlook 365 Using Outlook 15
CWM550 Saving Data: Don't check certain folders Using Outlook 2
M Saving emails using Visual Basic - Selecting folder with msoFileDialogFolderPicker Outlook VBA and Custom Forms 6
D Outlook 2016 Outlook not saving Sent Items Using Outlook 4
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
M 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

Back
Top