我正在嘗試爲Outlook編寫一個小的宏程序。 本程序應自動將傳入電子郵件的文本保存爲文本文件。VBA自動從outlook中保存收到的電子郵件
我發現大量的代碼,並試圖使這項工作,但它仍然無法正常工作。
Option Explicit
Public Enum olSaveAsTypeEnum
olSaveAsTxt = 0
olSaveAsRTF = 1
olSaveAsMsg = 3
End Enum
Private WithEvents Items As Outlook.Items
Private Const MAIL_PATH As String = "C:\mails\"
'Private Const MAIL_PATH As String = "C:\Users\dirk\AppData\Local\Microsoft\Outlook\"
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ItemsItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAsTxt, MAIL_PATH
End If
End Sub
Private Sub SaveMailAsFile(oMail As Outlook.MailItem, eType As olSaveAsTypeEnum, sPath As String)
Dim dtDate As Date
Dim sName As String
Dim sFile As String
Dim sExt As String
Select Case eType
Case olSaveAsTxt = sExt = ".txt"
Case olSaveAsMsg = sExt = ".msg"
Case olSaveAsRTF = sExt = ".rtf"
Case Else: Exit Sub
End Select
sName = oMail.Subject
RecplaceCharsForFileName sName, "_"
dtDate = oMail.RecievedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(dtDate, "-hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & sExt
oMail.SaveAs sPath & sName, eType
End Sub
Private Sub RecplaceCharsForFileName(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, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
sName = Replace(sName, "Chr(34)", sChr)
End Sub
我不是在一個單獨的模塊,但已有的ThisOutlookSession
模塊中寫了這個代碼。
有誰能告訴我我做錯了什麼?
錯誤消息是什麼,你呢?什麼不起作用?此外,關於'ItemAdd'事件(不確定您是否正確使用它):http://msdn.microsoft.com/en-us/library/office/bb220152%28v=office.12%29.aspx – dnLL
(1)這段代碼需要放在類模塊中。 (2)您需要在Outlook啓動時實例化類。 – JimmyPena