• This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn more.

Save and rename outlook email attachments to include domain name & date received

weslake77

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Outlook.com (as MS Exchange)
#1
Hi all,
I'm not a developer and quite the beginner. I work for my family on a farm and we have a heap of invoices coming in each month via email and I'd love to be able to create a macro that allows all attachments that are invoices or statements to be saved to a file on my computer.
I have a macro that is currently functioning well that pulls all attachments that include the words Ïnvoice or Statement into a folder on my computer.
This is it below:

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\Sarah\OneDrive\Accounts & Invoices\2018\Email Invoice Attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

But now I have a huge file filled with a bunch of files (invoices and statements) that are badly named and I don't know what they are unless I open them up.
So, I'd love to be able to rename the attachment to include the email domain & the date received.
For example - I get an invoice from a company called Queensland Bearings - their email address is "admin@queenslandbearings.com.au" and the email was received on the 1st April 2018. I would like the attachment to be saved as "QueenslandBearings-20180401"
Can someone please help me with the code for this?
Greatly appreciated
Sarah.
 

weslake77

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Outlook.com (as MS Exchange)
#2
Hi all, pretty desperate for a reply. Your help would be greatly appreciated
 

niton

New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
#3
You can extract somewhat useful information out of SenderEmailAddress.

Code:
Public Sub SaveAttachmentsToDisk(MItem As mailItem)

    Dim oAttachment As attachment
    Dim sSaveFolder As String
 
    Dim sndrEmailAdd As String
    Dim sndrEmailRight As String
    Dim sndrEmailPreDot As String
    
    Dim saveName As String
 
    ' Try on a test folder not your current folder
    sSaveFolder = "C:\Users\Sarah\OneDrive\Accounts & Invoices\2018\Email Invoice Attachments\"
        
    '  Extract text, after @ and before dot, from the email address.
    sndrEmailAdd = MItem.SenderEmailAddress
        
    'Debug.Print sndrEmailAdd
    'Debug.Print " position of @ sign: " & InStr(sndrEmailAdd, "@")
    'Debug.Print " number of characters right of @ sign: " & Len(sndrEmailAdd) - InStr(sndrEmailAdd, "@")
    
    sndrEmailRight = Right(sndrEmailAdd, Len(sndrEmailAdd) - InStr(sndrEmailAdd, "@"))
    'Debug.Print " text after @ sign: " & sndrEmailRight
    
    'Debug.Print " position of the (first) . period in the remaining text: " & InStr(sndrEmailRight, ".")
    sndrEmailPreDot = Left(sndrEmailRight, InStr(sndrEmailRight, ".") - 1)
    
    'Debug.Print " text before . period: " & sndrEmailPreDot
    
    For Each oAttachment In MItem.Attachments
            
        ' Without versioning code,
        '  if more than one attachment with same name they will overwrite.
        ' Would have been doing so previously,
        '  now less likely with the added prefix.
                
        saveName = sSaveFolder & sndrEmailPreDot & "-" & Format(MItem.ReceivedTime, "yyyymmdd") & "-" & oAttachment.DisplayName
        
        oAttachment.SaveAsFile saveName
        
    Next
 
End Sub

Sub saveDocumentsFromPreviouslyReceivedMailWithNewName()
    ' Open one old mail first
    SaveAttachmentsToDisk ActiveInspector.currentItem
End Sub
 

weslake77

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Outlook.com (as MS Exchange)
#4
Thank you so very much for taking the time to reply and send all of that code!
I'll give that go and let you know :)
Thanks
Sarah
 

weslake77

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Outlook.com (as MS Exchange)
#5
It worked beautifully!!! Thank you so much and also thank you for explaining the steps!! It's greatly appreciated!!
If you have any suggestions as to what websites or course that I should look into to learn VBA that would be great. If not, thanks again for all of your assistance :)