Autosave Attachments in Outlook Using VB Script

Question

I'm using the below code in Outlook 2010 to autosave attachments from a specific sender. The rule is working fine with the code but if a filename already exists in the folder, it will overwrite the file. Is there something I can add to tell it, that if that filename already exists, just add a number behind it? Even a timestamp after the filename would be fine, I just need something that won't overwrite files that are already in the folder.

Thanks.

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp\"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        Set objAtt = Nothing
    Next
End Sub

Answer 1

This is an admin scripting forum.  You want the Outlook VBA forum for these kinds of questions.

As a quick answer you can use a test for the file and not save it if the file exists.

A moderator will likely move this thread to the Outlook VBA forum.

---

¯\_(ツ)_/¯

Answer 2

Here is a hint:

Dim fso As Scripting.FileSystemObject
If Not fso.FileExists(FilePath) Then
   ' do someting
End If

---

¯\_(ツ)_/¯

Answer 3

Hi

I think you can add MailItem.ReceivedTime Property (Outlook) into the Attachments' name.

If there are multiple attachements with the same name in the mail. Jrv has already provided a good suggestion.

I do not use VBA so much, so below is only the logic

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim rTime As String
rTime = itm.ReceivedTime

'Replace the below line of code with your own code
'Since its not a valid VBA code. In this part, you
'should delete the chars that are forbbiden to use
'in a file name. Such as 9:00 may exist in the rTime
'string but the ":" cannot be used for file name, so
'you need to delete it or replace it with other char.

rTime = rTime.MethodToMakeItValidForFileName

saveFolder = "c:\temp\"
    For Each objAtt In itm.Attachments
        Dim SaveWithName As String
	SaveWithName = saveFolder & "\" & rTime &objAtt.DisplayName
        '1. Check if there are file with same name. 
        'If file with same name found -> 2.
        'Else if haven't found file with same name -> 3
	'2. Rename -> back to 1.
        '3. objAtt.SaveAsFile SaveWithName 
        Set objAtt = Nothing
    Next
End Sub

HTH.

---

Regards,
Fermin
What's life without whimsy?

Answer 4

Is there a way to put the timestamp after the attachment name? It looks like this will put the timestamp before the attachment name.

Answer 5

Of course you can. You'll need to find the last . and insert before it.

you can use InStrRev(FName, ".") to get where to insert timestamp.

see Separate Filename and Extension

---

Regards,
Fermin
What's life without whimsy?

Answer 6

Sorry, I'm still not getting it. I'm not real familiar with scripting so that's where my confusion is. Basically, I get an email from a specific sender (which I'd setup in a rule) and I want to save the attachment to a folder. However, I may already have a file in that folder that has the same filename (usually it's lastname/firstname of customers) so I would like it to add a timestamp or an increasing number at the end.

Answer 7

An attachment is a file. A file may have a file name which includes the extension name to tell the file type.

For example, you have a PersonalResume.docx file which is an document. I think you've already know that docx is the extension name. It's separated the document's name by a dot. By using  InStrRev(FName, ".") you'll know where the dot is and you can insert your timestamp there.

The method can be seen in Separate Filename and Extension as I mentioned in the last reply.

To figure the code out, you'll need to figure out the logic first then follow the syntax of the language you're working with. I've already show you the logic in my 1st reply.

HTH

---

Regards,
Fermin
What's life without whimsy?

Answer 8

Try this: (haven't tested it but it works on my add-in so it could do the same for a macro)

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp\"
Dim strAppend as String
strAppend = RemoveTimeMarks(itm.ReceivedTime)
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & strAppend & objAtt.DisplayName
        Set objAtt = Nothing
    Next
End Sub

Public Function RemoveTimeMarks(ByVal strInput As String) As String
        Dim strOut As String
        strOut = RemoveInvalid(strInput)
        strOut = strOut.Replace(" ", "_")
        strOut = strOut.Replace("A", "")
        strOut = strOut.Replace("P", "")
        strOut = strOut.Replace("M", "")
        RemoveTimeMarks = strOut
End Function

Public Function RemoveInvalid(strInput as String) as String

Dim arrayInv As String() = {"<", ">", "|", "/", "*", "\", "?", """", "@", "%", "!", "#", "^", "&", "(", ")", ":", ";", "'", "{", "}", "+", "=", "-"}

        Dim j As Integer
        For j = 0 To arrayInv.Length - 1
            strInput = strInput.Replace(arrayInv(j), "")
        Next j
        RemoveInvalid = strInput

End Function

It will append the timestamp on its filename.