VB.NetでOutlookのメールをmsgファイルに書き出し

sample.vb

'https://social.msdn.microsoft.com/Forums/ja-JP/04531896-4b17-4b7f-851b-4b43dad05438

Imports Microsoft.Office.Interop 'OutlookのCOM参照を追加

Module Module1

    Sub Main()

        '出力先のフォルダ
        Dim output As String = System.IO.Path.Combine(System.Environment.GetFolderPath(System.Environment.SpecialFolder.MyDocuments), "output_msg")
        System.IO.Directory.CreateDirectory(output)

        Dim app As Outlook.Application
        app = New Outlook.Application

        Dim mapi As Outlook.NameSpace = app.GetNamespace("MAPI")
        Dim folder As Outlook.Folder = mapi.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)

        For Each item As Outlook.MailItem In folder.Items.OfType(Of Outlook.MailItem)()

            If item.ReceivedTime > DateTime.Now.AddDays(365) Then '1年前以内のみ処理の場合
                Continue For
            End If

            Dim subject As String = item.Subject.Trim()
            subject = item.ReceivedTime.ToString("yyyyMMddHHmmss") & "_" & subject 'ファイル名に受信日時を追加

            If subject.Length > 100 Then
                subject.Substring(0, 100) 'ファイル名が長すぎる場合は切り捨て
            End If

            For Each c As Char In System.IO.Path.GetInvalidFileNameChars()
                subject = subject.Replace(c, "_") 'ファイル名に使えない文字は置換
            Next

            Dim path As String = System.IO.Path.Combine(output, subject)
            Dim fullpath As String
            Dim i As Integer = 0

            fullpath = System.IO.Path.Combine(output, subject & ".msg")
            Do While System.IO.File.Exists(fullpath)
                i = i + 1
                fullpath = System.IO.Path.Combine(output, subject & "_(" & i.ToString & ").msg") 'すでにあるファイルの場合は別名に
            Loop


            item.SaveAs(fullpath, Outlook.OlSaveAsType.olMSG) '保存
        Next
    End Sub

End Module