このページでわかること
受信メールを取得し、内容をエクセルに転記することができます。
未読メールだけを取得することも可能です。
覚えること
- メールの取得
フォルダオブジェクト.Items(数値) - メールの要素の取得
フォルダオブジェクト.Items(数値).プロパティ名 - メールの既読、未読の確認
フォルダオブジェクト.Items(数値).Unread=True or False
True:既読、False:未読
こんにちは、hokuhokuです。
前回の記事でOutlookを立ち上げることができました。
今回はOutlookの受信メールにアクセスし、
メール内容をエクセルに転記してみたいと思います。
スポンサーリンク
受信メールの取得方法
Itemsプロパティを使います。
構文：フォルダオブジェクト.Items(数値)
Items()の()に数値を入れます。
数値は受信メールの上からの番号に対応しており、
1番目のメールを取得したければ、Items(1)とします。
メールの構成要素（プロパティ）を取得
メールは受信時間や、タイトル、本文など様々な要素から成り立っており、
それらを個別に取得することができます。
よく使うものを表にしておきました。
| プロパティ | 説明 |
| To | 宛先 |
| CC | CC |
| BCC | BCC |
| SentOn | 送信日時 |
| Subject | タイトル |
| Body | 本文 |
| BodyFormat | 本文の形式 テキスト形式:olFormatPlain リッチ テキスト形式(RTF):olFormatRichText HTML:olFormatHTML |
| attachments | 添付ファイル |
注意！ 前回のメール立ち上げ記事と若干立ち上げ方が違っています。 前回は１つ以上Outlookが立ち上がっていたらプログラム終了していました。 今回もそれをやるとOutlookが立ち上がっていると何も起こらなくなってしまうので、 Outlookが2個以上立ち上がっているとき、最後に立ち上げたOutlookを閉じるというプログラムに変えています。 これにより、むやみやたらにOutlookは増えないし、プログラムが発生しないってこともありません。
Sub 受信メール()
'宣言
Dim outlookObj As New Outlook.Application 'Outlookを扱う準備
Dim myNamespace As Outlook.Namespace 'Outlookを扱う準備
Dim mailDir As Folder '受信メールのフォルダオブジェクト
Dim i As Long 'メールのインデックス番号
Dim j As Long '転記先のシート用
Dim wsTenki As Worksheet '転記先
Dim outlookCnt As Long 'Outlookの画面の数
Set myNamespace = outlookObj.GetNamespace("MAPI") 'Outlookを扱う準備
Set mailDir = myNamespace.GetDefaultFolder(olFolderInbox) '受信メールのフォルダをセット
Set wsTenki = ThisWorkbook.Worksheets("転記先")
'受信メールフォルダ表示
mailDir.Display
'Outlookを何個開いているか
'2個以上開いていたら最後に開いたものを閉じる
outlookCnt = outlookObj.Explorers.Count
If outlookCnt >= 2 Then
outlookObj.Explorers.Item(outlookCnt).Close
End If
'受信メールフォルダの上から5番目までのメールを処理
'最初は2行目に転記する
j = 2
For i = 1 To 5
With mailDir.Items(i)
wsTenki.Cells(2, j).Value = .To '宛先
'wstenki.Cells(2, j).Value = mailDir.Items(i) & ".To"
wsTenki.Cells(3, j).Value = .CC 'ＣＣ
wsTenki.Cells(4, j).Value = .BCC 'ＢＣＣ
wsTenki.Cells(5, j).Value = .SentOn '送信日時
wsTenki.Cells(6, j).Value = .Subject 'タイトル
wsTenki.Cells(7, j).Value = .Body '本文
wsTenki.Cells(8, j).Value = .BodyFormat '本文の形式
'添付ファイルが一つ以上あるときに添付ファイルのタイトル転記
If .Attachments.Count > 0 Then
wsTenki.Cells(9, j).Value = .Attachments.Item(1)
End If
End With
'一つしたの行に転記するための準備
j = j + 1
Next i
End Sub未読メールのみ取得する方法
上記のプログラムでメール情報を取得することができました。
今度は受信メールで未読の分だけ情報取得する方法をご紹介します。
Unreadプロパティを使用します。
構文：フォルダオブジェクト.Items(数値).Unread
未読の場合はTrue、既読の場合はFalseとなります。
これをIf分でTrueの場合だけ処理すれば未読分を転記可能です。
転記した未読メールは既読に変えるようにしました。
未読のままがよければコードを削除すれば大丈夫です。
Sub 受信メール_未読のみ()
'宣言
Dim outlookObj As New Outlook.Application 'Outlookを扱う準備
Dim myNamespace As Outlook.Namespace 'Outlookを扱う準備
Dim mailDir As Folder '受信メールのフォルダオブジェクト
Dim i As Long 'メールのインデックス番号
Dim j As Long '転記先のシート用
Dim wsTenki As Worksheet '転記先
Dim outlookCnt As Long 'Outlookの画面の数
Set myNamespace = outlookObj.GetNamespace("MAPI") 'Outlookを扱う準備
Set mailDir = myNamespace.GetDefaultFolder(olFolderInbox) '受信メールのフォルダをセット
Set wsTenki = ThisWorkbook.Worksheets("転記先")
'受信メールフォルダ表示
mailDir.Display
'Outlookを何個開いているか
'2個以上開いていたら最後に開いたものを閉じる
outlookCnt = outlookObj.Explorers.Count
If outlookCnt >= 2 Then
outlookObj.Explorers.Item(outlookCnt).Close
End If
'受信メールフォルダの上から5番目までのメールを処理
'最初は2行目に転記する
j = 2
For i = 1 To 5
With mailDir.Items(i)
If .UnRead = True Then
wsTenki.Cells(2, j).Value = .To '宛先
wsTenki.Cells(3, j).Value = .CC 'ＣＣ
wsTenki.Cells(4, j).Value = .BCC 'ＢＣＣ
wsTenki.Cells(5, j).Value = .SentOn '送信日時
wsTenki.Cells(6, j).Value = .Subject 'タイトル
wsTenki.Cells(7, j).Value = .Body '本文
wsTenki.Cells(8, j).Value = .BodyFormat '本文の形式
'添付ファイルが一つ以上あるときに添付ファイルのタイトル転記
If .Attachments.Count > 0 Then
wsTenki.Cells(9, j).Value = .Attachments.Item(1)
End If
'処理したメールを既読にする場合（しない場合は消してください）
.UnRead = False
'一つ下の行に転記するための準備
j = j + 1
End If
End With
Next i
End Subちょっと長くなってしまいすみません。
このままでも使用できると思いますが、
このマクロは動かす度にメールを取得、転記するので
ダブって処理する可能性があります。
そこで、
SubjectとSentOnの組み合わせた文字列を取得し、
既に転記しているものと比較して、
被っていないもののみを転記する
というマクロを組めば全てのメールを転記できます。
さらにさらに、本文から抜き取りたい情報を抽出すればメールを見なくても
重要な情報を整理することが可能です。
→いつかご紹介します。
ではでは
スポンサーリンク
