なにかとメールが埋もれがちなOutlookですので、VBAを使ってExcelに取り込んで一覧にできないかと考えて、VBAプログラムを作成しました。

 実行するとこのようになります。
f:id:Suechan:20161004222414j:plain


 Outlookは起動しておいてください。Excelには「メール取得」というシートを作成してください(中身不要)。

     Outlookのメール一覧を作成する
    Dim ol As Object
    Dim sht As Worksheet
    Dim rowCnt As Long
    
     起動しているOutlookを取得
    Set ol = GetObject(, "Outlook.Application")
    If ol Is Nothing Then Exit Sub
    
    Set sht = Worksheets("メール取得")
    
     シートクリア
    With sht
        .Cells.Clear
        .Cells(1, 1).Value = "受信日時"
        .Cells(1, 2).Value = "差出人"
        .Cells(1, 3).Value = "CC"
        .Cells(1, 4).Value = "本文"
    End With
    
     メール一覧取得
    rowCnt = 1
    For Each itms In ol.GetNamespace("MAPI").GetDefaultFolder(6).Items   olFolderInbox:6
        If itms.Class = 43 Then  olMail:43
            sht.Cells(rowCnt + 1, 1).Value = itms.ReceivedTime   受信日時
            sht.Cells(rowCnt + 1, 2).Value = itms.SenderName     差出人
            sht.Cells(rowCnt + 1, 3).Value = itms.CC             CC
            sht.Cells(rowCnt + 1, 4).Value = itms.Body           本文
            
            rowCnt = rowCnt + 1
        End If
    
    Next
    
    
     サブフォルダ取得版
    For Each itms1 In ol.GetNamespace("MAPI").GetDefaultFolder(6).Folders
        
        If itms1.Name = "テスト" Then
            For Each itms2 In itms1.Items
                sht.Cells(rowCnt + 1, 1).Value = itms2.ReceivedTime   受信日時
                sht.Cells(rowCnt + 1, 2).Value = itms2.SenderName     差出人
                sht.Cells(rowCnt + 1, 3).Value = itms2.CC             CC
                sht.Cells(rowCnt + 1, 4).Value = itms2.Body           本文
                
                rowCnt = rowCnt + 1
            Next
        End If
    
    Next
    
    
    Set ol = Nothing
End Sub


 サブフォルダ対応版というものは、「受信トレイ」直下に「テスト」というフォルダがあることを想定しています。
f:id:Suechan:20161004222714j:plain
 適当に書き換えれば、使いまわしができるはずです。


 GetDefaultFolderはOlDefaultFolders 列挙 (Outlook)を参照してください。
 Items.ClassはOlObjectClass 列挙 (Outlook)を参照してください。


 また、処理時間ですが、マシンスペックなどの環境にかなり依存するようです。
 ・会社PC(Windows7+Office2010):800件を3分くらい(デスクトップ型i3-3220+HDD500GB)。
 ・家PC(Windows10+Office2016):500件を20秒くらい(ノート型i7-6500U+SSD512GB)。
 CPUもそうですが、SSDの差もあると思います。

 「本文」に多数の改行が入っているため、Excelのセルにセットする際、セルの高さが変わることで、負荷になっている可能性が非常に高いです。
 対策としてvbCrLfでSplitを使い、本文を改行ごとにセル分けすると、非常に高速に処理できます。が、縦にセットしても、横にセットしても、どっちも見た目上美しくできないので採用しませんでした。


 動作確認はExcel2016&Outlook2016とExcel2010&Outlook2010で行っています。

 suechan.hateblo.jp