Add Random Numbers in File Name

I am using the attached code that I found here on ee to export emails from outlook to a .msg file in a folder of my choice.  It's working great, except for one problem.  When I use the script on e-mails that have identical subject lines, I only end up with one file for the multiple messages, since each one overwrites the last.  For example, if I have three messages in my inbox, and the subject line on each one is:  
RE:Test Email
When the three get exported, I only end up with one message, not three in the export folder since the first two were overwritten.  So, it seems like if I could have a random number inserted at the end of the file name, that would resolve the issue.  In the code attached you'll see I've added the date/time to the filename, but since it can take under a second to export a sinlge message, this is not working to prevent the overwrites.

So, how would I go about adding a random number to the file name?  Or, is there a better solution to my entire problem?

Thanks much for your help!!


Sub SaveFile()
    Dim olkItem As Object, _
        strPath As String, _
        strFilename As String
    'Replace the path on the next line with your path
    strPath = "C:\Emails\"
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    Else
        For Each olkItem In Application.ActiveExplorer.Selection
            strFilename = strPath & ReplaceIllegalCharacters(olkItem.Subject) & " _ " & _
            Format(Now(), "hh mm ss") & ".msg"
            'Format(Now(), "mm_dd_yyyy hh mm ss AMPM") & ".msg"
            
            olkItem.SaveAs strFilename, olMSG
        Next
        Set olkItem = Nothing
    End If
End Sub
Function ReplaceIllegalCharacters(strSubject As String) As String
    Dim strBuffer As String
    strBuffer = Replace(strSubject, ":", "")
    strBuffer = Replace(strBuffer, "\", "")
    strBuffer = Replace(strBuffer, "/", "")
    strBuffer = Replace(strBuffer, "?", "")
    strBuffer = Replace(strBuffer, Chr(34), "'")
    strBuffer = Replace(strBuffer, "|", "")
    ReplaceIllegalCharacters = strBuffer
End Function

Open in new window

tim90gAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
Why use a random number, as that will mess up your sorting?

The amended code below uses the date/time the file was received.

Note that I use the ISO yyyy-mm-dd format to ensure that things will always sort chronologically.


Sub SaveFile()
    Dim olkItem As Object, _
        strPath As String, _
        strFilename As String
    'Replace the path on the next line with your path
    strPath = "C:\Emails\"
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    Else
        For Each olkItem In Application.ActiveExplorer.Selection
            strFilename = strPath & ReplaceIllegalCharacters(olkItem.Subject) & " _ " & _
            Format(olkItem.ReceivedTime, "yyyy-mm-dd hh nn ss") & ".msg"
            'Format(Now(), "mm_dd_yyyy hh mm ss AMPM") & ".msg"
            
            olkItem.SaveAs strFilename, olMSG
        Next
        Set olkItem = Nothing
    End If
End Sub
Function ReplaceIllegalCharacters(strSubject As String) As String
    Dim strBuffer As String
    strBuffer = Replace(strSubject, ":", "")
    strBuffer = Replace(strBuffer, "\", "")
    strBuffer = Replace(strBuffer, "/", "")
    strBuffer = Replace(strBuffer, "?", "")
    strBuffer = Replace(strBuffer, Chr(34), "'")
    strBuffer = Replace(strBuffer, "|", "")
    ReplaceIllegalCharacters = strBuffer
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
peetmCommented:

You could an incrementing number in the loop:

Dim inc

For Each olkItem In Application.ActiveExplorer.Selection
            strFilename = strPath & ReplaceIllegalCharacters(olkItem.Subject) & " _ " & Format(Now(), "hh mm ss") & inc & ".msg"
            inc = inc + 1
            olkItem.SaveAs strFilename, olMSG
Next
0
tim90gAuthor Commented:
That's exactly the kind of solution I needed!! Thanks so much!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.