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:
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!!
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
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
Set olkItem = Nothing
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