VBAと共に去りぬ：Outlook VBAを制すものはSES業界を制す

# 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

```