Save Outlook attachment in network folder and rename to current date and time

Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#1
Hi All

I am new to the forum and need help please with a piece of code which will achieve what the title says above.

I currently have the below code in a module called by an outlook rule to run on incoming emails. All incoming attachments are .xlsx attachments and are renamed with the same file extension. The issue I have is that once the vb code renames the file name to the current date and time and saves the file in the network folder, I can no longer open the file and receive the error that the file format or extension may not be correct or the file is corrupt, but the file is fine before renaming.

Also the code below causes confusion on emails which have more than 1 attachment, so ideally I need the code to work through all attachments in the incoming email.

Code as follows: (Many thanks in advance for your help):

Code:
Sub SaveAttachmentsToDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim att As Object

saveFolder = "\\server\share"  ' change to your path

For Each objAtt In itm.Attachments

        If itm.Attachments.Count > 0 Then
       
            For Each att In itm.Attachments
           
                If att.FileName Like "*.xlsx" Then

                objAtt.SaveAsFile saveFolder & "\" & Format(Now, "dd-mm-yy-hh-mm-ss") & ".xlsx"
   
                itm.UnRead = False
   
                End If
   
            Next att
   
        End If

Next

End Sub
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#2
Also the code below causes confusion on emails which have more than 1 attachment, so ideally I need the code to work through all attachments in the incoming email.
In what way does it cause confusion?

Try using
if Right(Att.DisplayName, 5) = ".xlsx" Then
 
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#3
Hi Diane, many thanks for your reply.

If there are multiple attachments on one receiving email, the code will create multiple instances of the file, so if there were originally 2 attachments, the code appears to save 4, so in affect doubling up?

I will try your suggestion and post back. Is there any reason the excel files are corrupting when the code renames the file?
 
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#4
Where would I be best inserting the code snippet you suggest above please?
 
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#5
Sorry diane just realised I need to replace the code line referencing 'Like ".xlsx", with your code.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#6
I think this is the problem -
saveFolder = "\\server\share" ' change to your path

Test it using a local path. Saving to network shares has been problematic - it can help if the share is mapped.
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#7
Sorry diane just realised I need to replace the code line referencing 'Like ".xlsx", with your code.
I don't think that is the problem though - it worked fine using like when i ran it with a local folder path. (I had assumed the confusion was due to it trying to save all of the attachments, not just the xlsx).
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#8
If there are multiple attachments on one receiving email, the code will create multiple instances of the file, so if there were originally 2 attachments, the code appears to save 4, so in affect doubling up?
Hmmm. I'm not seeing that, at least not with multiple attachments, of which only one is xlsx.

This should properly handle multiple files:
If itm.Attachments.Count > 0 Then
For Each att In itm.Attachments

BTW, the only thing I would change is putting the \ in the save folder path instead of adding it later:
saveFolder = "\\server\share\" ' change to your path

objAtt.SaveAsFile saveFolder & Format(Now, "dd-mm-yy-hh-mm-ss") & ".xlsx"


Do the files you save to the network ever open ok later?
 
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#9
Okay I think I am getting somewhere. Now including your changes, there are 2 copies of the workbook saving to the network folder, one of them is 1kb in size (this one won`t open, corruption message as before), but the second one opens perfectly and shows the a more normal file size of 13kb.

Is there any way to stop the second corrupt file coming in? Is this possibly the temp file being renamed and is also saving as well as the actual file?
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#10
Ok... i can repro it with 2 xlxs files. I made a couple of change for testing so i could see what it was doing. its getting the names correct but saving the one file under both names.

Code:
For Each att In itm.Attachments
Debug.Print att.FileName
                If att.FileName Like "*.xlsx" Then

                objAtt.SaveAsFile saveFolder & att.FileName & Format(Now, "dd-mm-yy-hh-mm-ss") & ".xlsx"
  
                itm.UnRead = False
  
                End If
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#11
Is there any way to stop the second corrupt file coming in? Is this possibly the temp file being renamed and is also saving as well as the actual file?
Yeah, its something like that, but i'm seeing different weirdness too.

There is a KB floating around somewhere that explains it, but i couldn't find it in a quickie search.
 
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server 2013
#12
Yeah this is a strange one. I will keep looking to resolve, otherwise I may have to try the mapped folder route.

Many thanks for your help Diane, I have seen your name all over google searches for outlook help, its great to have help from you. Thanks again
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#13
Sheesh... I'm blind as a bat. :) its the object names.

Dim objAtt As Outlook.Attachment
For Each objAtt In itm.Attachments

For Each objAtt In itm.Attachments

If itm.Attachments.Count > 0 Then

For Each att In itm.Attachments



change the att's in the code to objAtt
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#14
this is working here -

Code:
Sub SaveAttachmentsToDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String

saveFolder = "C:\Users\slipstick\Documents\"  ' change to your path
If itm.Attachments.Count > 0 Then
For Each objAtt In itm.Attachments
If Right(objAtt.DisplayName, 5) = ".xlsx" Then
  objAtt.SaveAsFile saveFolder & objAtt.DisplayName & Format(Now, "dd-mm-yy-hh-mm-ss") & ".xlsx"
  
    itm.UnRead = False
End If
Next
End If

End Sub
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#15
what was happening in your code - the first line ran through each attachment - then got the att count then saved... then went back to the objAtt and reran the code. So 2 attachments would loop 4 times.

For Each objAtt In itm.Attachments

If itm.Attachments.Count > 0 Then

For Each att In itm.Attachments
 

Similar threads

Top