2013-05-16 174 views
1

我正在嘗試爲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模塊中寫了這個代碼。

有誰能告訴我我做錯了什麼?

+0

錯誤消息是什麼,你呢?什麼不起作用?此外,關於'ItemAdd'事件(不確定您是否正確使用它):http://msdn.microsoft.com/en-us/library/office/bb220152%28v=office.12%29.aspx – dnLL

+0

(1)這段代碼需要放在類模塊中。 (2)您需要在Outlook啓動時實例化類。 – JimmyPena

回答

0

此外,關於ItemAdd事件(不知道你是否正確使用它):https://msdn.microsoft.com/en-us/library/office/bb220152(v=office.12).aspx - DNLL

Private Sub Items_ItemAdd(ByVal Item As Object) 
    If TypeOf Item Is Outlook.MailItem Then 
    SaveMailAsFile Item, olSaveAsTxt, MAIL_PATH 
    End If 
End Sub 
+0

答案在評論中。任何在搜索中發現此主題的人都會看到有答案,並且更有可能尋找有希望的有用答案。 – niton

相關問題