Outlook visual basic for applications文件命名冲突问题

Question

我正在尝试将电子邮件从Outlook 2007集中传输到我的C:/驱动器。这个想法是根据电子邮件的主题和日期将其保存为一个易于阅读的标识符。

当有两封主题和日期戳相同的电子邮件时，就会出现运行时错误，如果你愿意的话，这是一个命名冲突。

我可以在文件名中添加一个唯一的序列号或几分之一秒吗？

在.NET中，我只需要添加ss^ff或其他东西，但我不知道如何使用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

可能不是最漂亮的，但可以试试这样的东西。

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