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

[wallen1605]

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):

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

 

[Diane Poremsky]

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

 

[wallen1605]

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?

 

[wallen1605]

Where would I be best inserting the code snippet you suggest above please?

 

[wallen1605]

Sorry diane just realised I need to replace the code line referencing 'Like ".xlsx", with your code.

 

[Diane Poremsky]

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.

 

[Diane Poremsky]

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).

 

[Diane Poremsky]

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?

 

[wallen1605]

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?

 

[Diane Poremsky]

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.

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

 

[Diane Poremsky]

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.

 

[wallen1605]

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

 

[Diane Poremsky]

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

 

[Diane Poremsky]

this is working here -

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

 

[Diane Poremsky]

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

 

[wallen1605]

Hi Diane, thank you so much, this worked perfectly, thanks for your time

 

[wallen1605]

Hi Diane,

I am sorry if I need to post a new question on this, but you kindly provided me with the code in the above message thread to save the excel attachment of incoming emails to a network path which works great to this day (used daily), however I need to adapt this outlook code to open this saved excel document, then add a new worksheet before Sheets(1) named 'Email' and then add the email fields of 'From' address, 'Subject' and mail body into cells A1, A2, A3 respectfully and auto fit to portrait A4 width size (210mm) and wrap the text.
I understand the outlook code cannot open the attachment directly, but it can open it once stored on the network share, then insert the email fields mentioned above and save, then close the excel document on the server?
I have looked at many options and examples but I am lost. Please could you help?

Many thanks in advance.

 

[Diane Poremsky]

are you saving the workbook then editing it? See Save and Open an Attachment using VBA

For adding a sheet and doing the other stuff, record a macro in excel then copy and paste it in outlook's VBA editor, tweaking it to work from outlook.

 

[wallen1605]

are you saving the workbook then editing it? See Save and Open an Attachment using VBA

For adding a sheet and doing the other stuff, record a macro in excel then copy and paste it in outlook's VBA editor, tweaking it to work from outlook.

Hi Diane, yes the outlook code is save the file, i need to edit the excel file by opening and editing from outlook.