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

質問

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

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

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

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

回答No.3

name_mm_ok

これが、OfficeXP(2002)のOutlook、Excelで動作したコードです。
このコードで回避できないのは、メール本文にアクセスした際、
セキュリティ関連のダイアログが開き、アクセス可能な時間を選択
する必要がある事です。
この件に関しては、私のレベルでは回避不可能でした。

Option Explicit

'Excelアプリケーション内にアクティブになっているワークシートが
'存在する事を前提に作りました。

Private Sub GetRcvMailInfo()

Dim objOApp As Object 'Outlook.Application
Dim objNameSpace As Object 'Outlook.NameSpace
Dim objDFld As Object 'Outlook.MAPIFolder
Dim objFld As Object 'Outlook.MAPIFolder
Dim objItem As Object 'Outlook.MailItem
Dim objEApp As Object 'Excel.Application
Dim objASht As Object 'Excel.Worksheet
Dim i As Long

'複数のデータフォルダを使用している場合
Const DATAFOLDER As String = "業務用フォルダ"
'抽出対象のフォルダ名称を指定
Const SUBFOLDER As String = "受信トレイ"

Set objOApp = CreateObject("Outlook.Application")

Set objNameSpace = objOApp.GetNamespace("MAPI")

For Each objDFld In objNameSpace.Folders

Debug.Print objDFld.Name

If objDFld.Name = DATAFOLDER Then

For Each objFld In objDFld.Folders
Debug.Print objFld.Name
If objFld.Name = SUBFOLDER Then
Exit For
End If
Next objFld

'objFld.Name = SUBFOLDER の判定でTrueとなったかを判定
If Not objFld Is Nothing Then
i = 1

Set objEApp = Excel.Application

objEApp.ScreenUpdating = False 'Excelの更新を一時的に停止

Set objASht = objEApp.ActiveSheet

For Each objItem In objFld.Items
If objItem.UnRead = True Then
objASht.Cells(i, 1) = objItem.Subject
objASht.Cells(i, 2) = objItem.Body
objASht.Cells(i, 3) = objItem.ReceivedTime
i = i + 1
End If
Next objItem

objEApp.ScreenUpdating = True 'Excelの更新を再開

Exit For
End If

End If

Next objDFld

objOApp.Quit

Set objASht = Nothing
Set objEApp = Nothing
Set objASht = Nothing
Set objItem = Nothing
Set objFld = Nothing
Set objDFld = Nothing
Set objNameSpace = Nothing
Set objOApp = Nothing

End Sub

お礼

アドバイスありがとうございます！！
せっかくアドバイスいただいたのに、お礼が遅くなってしまい
本当に申し訳ございません！！！
ちょっと別件で忙しくなってしまい、こちらはいったん保留となっておりました。
詳しいコードをありがとうございます。
まだ、実動できてはいないのですが
このコードを解読して、頑張ってみたいと思います。
もっと勉強して、私も誰かの質問に答えられるようになりたいとおもいます。
本当にありがとうございました！
またどうしても解らないことがありましたら、ぜひご教示ください。