Question

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

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

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

在.NET中，我只想添加ss ^ ff或其他东西，但我不知道如何使用visual basic for the application。

*

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

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

1 个答案: