0

メールをまとめて Outlook 2007 から C:/ ドライブに転送しようとしています。アイデアは、件名と日付に基づいて電子メールを読みやすい識別子として保存することです。

同じ件名と日付スタンプを持つ 2 つの電子メールがある場合、実行時エラーが発生し、必要に応じて名前の競合が発生します。

ファイル名に一意の連番や秒単位を追加できますか?

.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

*

4

1 に答える 1

0

おそらく最もきれいではありませんが、このようなものを試してください.

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 
于 2013-11-11T18:55:35.227 に答える