Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/17.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
VBA自动保存来自outlook的传入电子邮件_Vba_Outlook - Fatal编程技术网

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

VBA自动保存来自outlook的传入电子邮件,vba,outlook,Vba,Outlook,我正在尝试为outlook编写一个小型宏程序。 程序应自动将收到的电子邮件文本保存为文本文件 我找到了大量的代码,并试图使其工作,但它仍然无法工作 Option Explicit Public Enum olSaveAsTypeEnum olSaveAsTxt = 0 olSaveAsRTF = 1 olSaveAsMsg = 3 End Enum Private WithEvents Items As Outlook.Items Private Const MA

我正在尝试为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事件不确定您是否正确使用它:–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

你有什么错误信息?什么不起作用?另外,关于ItemAdd事件不确定您是否正确使用它:1此代码需要放在类模块中。2您需要在Outlook启动时实例化该类。答案在注释中。任何在搜索中找到这个主题的人都会看到答案,并且更有可能寻找一个有用的答案。