|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Private Sub DumpMail() Dim myNameSpace As NameSpace Dim myFolder As MAPIFolder Dim Mi As MailItem Dim At As Attachment Dim I%, J%, sTime$, Ssubject$ Set myNameSpace = Application.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox) For I = 1 To myFolder.Items.Count Set Mi = myFolder.Items(I) sTime = Format(Mi.ReceivedTime, "yyyy-mm-dd hh/mm/ss") Ssubject = Mi.Subject Ssubject = Replace(Ssubject, "/", "", , , vbTextCompare) Ssubject = Replace(Ssubject, "\", "", , , vbTextCompare) Ssubject = Replace(Ssubject, ":", "", , , vbTextCompare) Ssubject = Replace(Ssubject, "*", "", , , vbTextCompare) Ssubject = Replace(Ssubject, "?", "", , , vbTextCompare) Ssubject = Replace(Ssubject, """", "", , , vbTextCompare) Ssubject = Replace(Ssubject, "<", "", , , vbTextCompare) Ssubject = Replace(Ssubject, ">", "", , , vbTextCompare) Ssubject = Replace(Ssubject, "|", "", , , vbTextCompare) Mi.SaveAs "d:\" & Ssubject & "-" & sTime & ".msg", olMSG If Mi.Attachments.Count > 0 Then For Each At In Mi.Attachments At.SaveAsFile "d:\" & At.FileName Next End If Next Set Mi = Nothing Set myFolder = Nothing Set myNameSpace = Nothing End Sub |
|