vba - Outlook Visual Basic 应用程序文件命名冲突问题

Question

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

当有两封具有相同主题和日期戳的电子邮件时，会出现运行时错误，如果您愿意，则会发生命名冲突。

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

在 .NET 中，我只会添加 ss^ff 或其他内容，但我不知道如何使用应用程序的 Visual Basic 来做到这一点。

*

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