読者です 読者をやめる 読者になる 読者になる

意外となんとかなる日記

世迷言を心に、綺麗事を頭に

スポンサーリンク

VBAでOutlookのメールを取得し、Excelシートに一覧表示する(サブフォルダ対応版もあり)

一歩踏み込むVBA

 なにかとメールが埋もれがちな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

スポンサーリンク