excel/vba で outlook の メールを操作

事前に参照設定を読み込んでおく必要あり、次の二つ。

• Microsoft Scripting Runtime
• Microsoft Outlook x.0 Object Library(最新)

お借りしたソース:

• URL: https://www.fastclassinfo.com/entry/vba_outlook_receivedmail_analysis
• URL: http://officevba.info/
• URL: http://officevba.info/journal-attachments/

胴元/参考

• URL: https://docs.microsoft.com/ja-jp/office/vba/api/overview/outlook

''' >>> ActiveX のボタンを経由して操作する

Private Sub CommandButton1_Click()


   '''
    Dim InboxFolder, subfolder, i, n, k, attno As Long
    Dim sender, mes, path1 As String
    Dim outlookObj As Outlook.Application
    Dim myNameSpace, objmailItem As Object
    Dim fso As FileSystemObject

    ''' >>> outlook に関する 編集を設定
    Set outlookObj = CreateObject("Outlook.Application")
    Set myNameSpace = outlookObj.GetNamespace("MAPI")
    Set InboxFolder = myNameSpace.GetDefaultFolder(6)
    Set subfolder = InboxFolder.Folders("out01")
    Set finfolder = subfolder.Folders("fin")
    
    n = 11

    ''' >>> 保存先のディレクトリを設定
    mes = InputBox("メールの添付資料を保管用フォルダを新しく作成します。フォルダ名を入力してください")
    path1 = ThisWorkbook.Path & "\" & mes
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateFolder (path1)

    ''' >>> 解析する受信メールの範囲を毛低
    ''' >>> MsgBox subfolder.Items.Count
    For i = subfolder.Items.Count To 1 Step -1
        Set objmailItem = subfolder.Items(i)

        '''--- 受信メールの件数、受信日時、件名(タイトル)、送信者名、送信元のメールアドレス、内容(本文)を取得
        ' 他の要素は要調査
        ''' Range("A" & n).Value = i
        Range("A" & n).Value = n - 10
        Range("B" & n).Value = objmailItem.ReceivedTime
        Range("C" & n).Value = objmailItem.Subject
        Range("D" & n).Value = objmailItem.SenderName
        Range("E" & n).Value = objmailItem.SenderEmailAddress
        ''' Range("F" & n).Value = Left(objmailItem.Body, 100)
        Range("F" & n).Value = " " & objmailItem.Body

        '''--- メールの添付ファイルを保管する

        attno = objmailItem.Attachments.Count
        If attno > 0 Then
            For k = 1 To attno
                objmailItem.Attachments(k).SaveAsFile (path1 & "\" & objmailItem.Attachments(k).DisplayName)
            Next
            Range("G" & n).Value = k
        Else
            Range("G" & n).Value = "なし"
        End If

        ' objmailItem.Copy
        objmailItem.Move finfolder
        
        n = n + 1
    Next

    '''--- セットした変数を解除
    Set outlookObj = Nothing
    Set myNameSpace = Nothing
    Set InboxFolder = Nothing
    Set finfolder = Nothing

End Sub

予定: 本文をテキストとして生成する操作方法を確認する。