OutLook本文を、VBAでExcelに落としたい

質問

こんにちは。
先日、こちらのサイトのVisualBasicのカテゴリで質問したのですが、
1件アドバイスが入ったのに、表示されず、削除も出来ず
困ってしまったので、もう一度質問させていただきます。

タイトルの通りなのですが、
ExcelVBAで、OutLookの受信トレイの「未読」の件名、本文、受信時間を
Excelに一覧として落としたいのです。

いろいろサイトを見たりして、参考サイトで見つけたコードを
使って、思うとおりにカスタマイズしてもみたのですが、
どうしても思っていた通りには出来ませんでした。
上記やりたいことが出来るコード、参考サイトをご教示願えませんか？
ちなみに、OSはWindows2002です。

どうぞよろしくお願い致します。

回答No.2

name_mm_ok

VisualBasicでご質問された際のコードを確認しました。
追加行（１～３）とコメントしている行の追加及び、追加行のＸＸＸを取得したいフォルダの名称に変更し、Wendy02 様が回答されている未読メールの判定を For Each objItem ～ のループ内に挿入すれば動作すると思います。
今のPCにはOutlookがインストールされていないため、動作しないようであれば、その旨回答への補足を頂ければ、動作確認可能な環境で確認後再度回答致します。
今後のためにも、オブジェクトブラウザ、ブレイク、ウォッチ等、VBAの動作確認する際の方法について調べられたほうがいいかと思います。

For nFCNT = 1 To olNameSPC.Folders(1).Folders.Count
'イミディエイトウィンドウにフォルダ名称が出力されます。
'この行は現在取得可能な正しいフォルダ名称を確認後削除して下さい。
debug.print olNameSPC.Folders(1).Folders(nFCNT).Name
if olNameSPC.Folders(1).Folders(nFCNT).Name = "受信トレイ" Then '追加行(1)

'フォルダーの名称を書き込む
Cells(nYLINE, 1) = olNameSPC.Folders(1).Folders(nFCNT).Name
nYLINE = nYLINE + 1
'見出しを書き込む
Cells(nYLINE, 1) = "No."
Cells(nYLINE, 2) = "タイプ"
Cells(nYLINE, 3) = "作成日"
Cells(nYLINE, 4) = "件名"
Cells(nYLINE, 5) = "内容"
nYLINE = nYLINE + 1

'メッセージ数分ループ
For Each objItem In olNameSPC.Folders(1).Folders(nFCNT).Items

intCounter = intCounter + 1

'変数に代入（セルに直接でもいいかも？）
With objItem
dteCreateDate = .CreationTime
strSubject = .Subject
strItemType = TypeName(objItem)
strBody = .Body
End With

'セルに代入
Cells(nYLINE, 1) = intCounter
Cells(nYLINE, 2) = strItemType
Cells(nYLINE, 3) = dteCreateDate
Cells(nYLINE, 4) = strSubject
Cells(nYLINE, 5) = strBody

'セット位置を移動
nYLINE = nYLINE + 1

Next objItem

exit for '追加行(2)

end if '追加行(3)