1

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モジュールに記述しました。

誰が私が間違っているのか教えてもらえますか?

4

1 に答える 1

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
于 2015-03-03T22:10:57.713 に答える