outlook VBAじゃい
Outlook VBAを制すものはSES業界を制す
（因みにごめん、コードはexcel VBAです。タイトル詐欺。
ですが、outlookを操作するので、Outlook VBAじゃ。）
実行していることは下記の通りですが、
Excel VBAでoutlookを扱う、とても基本的なコードだと思うので、
色んな事に応用可能かと思います。
##実行してること
Outlook上で選んだメールをexcelに貼り付けるSubです。
貼り付ける項目は以下です。
・日時
・件名
・送信者
・flag種類
・ラベル名
（・本文）
メール本文の貼り付け処理はコメントアウトしているので、
使う場合は、コメントアウトを解除してね。
【対象】
'WS.Cells(pastingStartPointRow, 7).Value = oBjMailitem.Body
私個人がしたかったこと
★メールの件名一覧を付加情報つきでExcelに貼り付けたい、
★WBSのたたき台を自動生成したい
ラベル名に各チームメンバーを登録していて、
対応してくれた人のラベルをメールにつけてます。
その状態で貼り付けると、WBSのたたき台にはなります。
###ソースコード（Excel VBA)
'
'---
'2019/Dec/16th
'1. Outlook上でExcelに貼り付けたいメールを全て選択
'2. この subを実行
'3. 選択されたメールの件名や日付、ラベルなどのデータがexcelシートに貼り付けられる
'---
Sub listAllEmailSubject()
If MsgBox("you wanna list all subject???", vbYesNo) = vbYes Then
'''---コード1｜このコード内で使用する変数を宣言
Dim InboxFolder, i, n, k, attno As Long
Dim sender, mes, path1 As String
Dim outlookObj As Outlook.Application
Dim myNameSpace As Object
Dim oBjMailitem As Object
Dim fso As FileSystemObject
Dim myExplr As Outlook.Explorer
Dim objParentFolder As Outlook.Folder ' parent
Dim conV As Conversation 'email スレッド
Dim senderName As String 'senderの名前、Excel上のリクエスターになる
Dim cbData As New DataObject 'ClipBoard data object
Dim wb As Workbook
Set wb = ThisWorkbook
Dim WS As Worksheet
Set WS = wb.Worksheets("SubjectList")
Dim flagBox As String '0 = flagなし, 1 = flag完了, 2 = flagあり
Dim outTable As Table
Dim a As Long
Dim oRow As Outlook.Row
Dim test As Object
Dim SimpleItems As Outlook.SimpleItems
Dim pastingStartPointRow As Long
'test
Dim mpfInbox As Outlook.MAPIFolder
Dim oBj As Outlook.MailItem
'pre-preparation
Set outlookObj = CreateObject("Outlook.Application")
Set myNameSpace = outlookObj.GetNamespace("MAPI")
Set InboxFolder = myNameSpace.GetDefaultFolder(6)
Set myExplr = outlookObj.ActiveExplorer
'Emailがどこまでリスト化されているか確認
pastingStartPointRow = WS.Cells(1048576, 2).End(xlUp).Row + 1
'For文始まるよ
For i = 1 To myExplr.Selection.count
'get current email object
Set oBjMailitem = myExplr.Selection.Item(i)
'値の貼り付け
WS.Cells(pastingStartPointRow, 2).Value = oBjMailitem.ReceivedTime
WS.Cells(pastingStartPointRow, 3).Value = oBjMailitem.Subject
WS.Cells(pastingStartPointRow, 4).Value = oBjMailitem.SenderEmailAddress
'WS.Cells(pastingStartPointRow, 7).Value = oBjMailitem.Body
'flag種類の確認 一番新しいメール
If oBjMailitem.FlagStatus = 0 Then
flagBox = ""
ElseIf oBjMailitem.FlagStatus = 1 Then
flagBox = "flag完了"
ElseIf oBjMailitem.FlagStatus = 2 Then
flagBox = "flagあり"
End If
WS.Cells(pastingStartPointRow, 5).Value = flagBox
WS.Cells(pastingStartPointRow, 6).Value = oBjMailitem.Categories
pastingStartPointRow = pastingStartPointRow + 1
Next i
'''---コード7｜セットした変数を解除
Set outlookObj = Nothing
Set myNameSpace = Nothing
Set InboxFolder = Nothing
Else
'do nothing
End If
End Sub