Question

我正在尝试为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模块中编写。

有谁能告诉我，我做错了什么？

Answer 1

另外，关于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

VBA自动保存来自Outlook的传入电子邮件

1 个答案: