Outlook visual basic for applications file naming collision issue - vba

Question

I am trying to transfer emails en masse from Outlook 2007 to my C:/ drive. The the idea is to save emails based on their subject and the date as an easy to read identifier.
There is a runtime error when there are two emails with the same subject and date stamp, a naming collision if you will.
Can I add a unique sequential number or a fraction of a second to the file name?
In .NET, I would just add ss^ff or something, but I do not know how to do this with visual basic for applications.
*
Public Sub SaveAllMailsAsFile1()
Dim obj As Object
Dim oItems As Outlook.Items
Dim i As Long
Set oItems = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Acton").Items
For i = oItems.Count To 1 Step -1
Set obj = oItems(i)
If TypeOf obj Is Outlook.MailItem Then
SaveMailAsFile obj, "C:\Users\gasparm\Desktop\MB Emails\Acton\"
End If
Next
End Sub
Private Sub SaveMailAsFile(oMail As Outlook.MailItem, _
sPath As String _
)
Dim dtDate As Date
Dim sName As String
Dim sFile As String
Dim sExt As String
sExt = ".msg"
' Remove invalid file name characters
sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
' Build file name from subject and received date
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyy-mmm-dd HH.mm.ss ", vbMonday, vbFirstJan1) _
& " - " & sName & sExt
oMail.SaveAs sPath & sName, olMSG
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "", sChr)
sName = Replace(sName, "", sChr)
sName = Replace(sName, "|", sChr)
End Sub
*

Answer 1

Probably not the prettiest, but try something like this.
Dim ver as long
Dim sValidSubjectName As String
' Remove invalid file name characters
sValidSubjectName = oMail.Subject
ReplaceCharsForFileName sValidSubjectName, "_"
ver = 0
' Build file name from subject and received date
dtDate = oMail.ReceivedTime
uniqueName:
sName = Format(dtDate, "yyyy-mmm-dd HH.mm.ss ", vbMonday, vbFirstJan1) _
& " - " & sValidSubjectName & ver & sExt
If Dir(sPath & sName) = "" Then
oMail.SaveAs sPath & sName, olMSG
Else
ver = ver + 1
Goto uniqueName
End If