Outlook2007で作成したサンプルをExcel2007へ

前回の http://d.hatena.ne.jp/ken3memo/20120328/1332887607
Outlookで受信フォルダーを下の階層まで調べるコード
を Excelで動かしたくて、チャレンジしてみました。

やりたいこと:
Outlookで作成したVBA マクロを
Excelで動作させたい
移植してみます
(※移植は大げさですね、移動・微調整してみます。)

参照設定に
□MicroSoft Outlook
を追加して、
CreateObject("Outlook.Application")
しただけです。

怪しい実演動画

参照設定を行い、Excelでコードを走らせた動画です。
※蛇足で、後半コードを修正してハマってますが、無視してください・・・

いつもの右往左往・酔っ払い解説
VBA マクロ Outlook2007で作成したコードをExcel2007で使う
www.youtube.com

↑と合わせて、下のコードを見てください↓

作成したコード

参照設定後、
Set oApp = CreateObject("Outlook.Application")
しただけですが・・・

Option Explicit

Dim y As Integer 'Y行目

Sub main0328()

    Dim oNamespace As Namespace
    
    Dim oFolder As Outlook.Folder 'フォルダー
    
    Dim oApp As Outlook.Application
    
    Set oApp = CreateObject("Outlook.Application")
    
    ' NameSpace オブジェクトへの参照を取得します。
    Set oNamespace = oApp.GetNamespace("MAPI")
    
    ' 既定のフォルダへの参照を取得し、フォルダを表示します。
    Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox) '受信トレイを指定
    oFolder.Display   '選択したフォルダーの表示

    '表示関数を呼ぶ
    y = 1  '1行目からセット
    Call testFolder("", 1, oFolder) '↑上で取得した受信トレイ
    
    '使用したオブジェクトの解放　= Nothing
    oApp.ActiveExplorer.Close   '新しく開いてしまったフォルダーを閉じる
    Set oFolder = Nothing
    Set oNamespace = Nothing

End Sub

'folderオブジェクトを受け取ったら､
'受け取ったオブジェクトの名前
'と
'フォルダー内のアイテム (ここではメールの件名)
'を表示してみたいと思います｡
Sub testFolder(ByVal strFolderName, ByVal x As Integer, oFolder As Outlook.Folder)

    Dim mITEM As Outlook.MailItem 'メールアイテム
    Dim n As Integer              'ループのカウンター
    Dim c As Integer              'フォルダのループカウンタ

    'テストで名前の表示
    Debug.Print oFolder.Name
    Cells(y, x) = strFolderName & " / " & oFolder.Name
    y = y + 1

    'フォルダーの下には ITEMここではメール と サブフォルダーが存在します

    'メールアイテムの処理
    For n = 1 To oFolder.Items.Count 'アイテム数分ループ
        Set mITEM = oFolder.Items(n)
        '↑代入が終わったので、各プロパティに mITEM.XXXX で アクセスする
        Debug.Print "件名:" & mITEM.Subject '件名表示
        Cells(y, x) = "件名:" & mITEM.Subject '件名表示
        y = y + 1
    
    Next
    Debug.Print "---"
    Cells(y, x) = "---"
    y = y + 1

    'サブフォルダーの処理
    x = x + 1  '右に移動
    For c = 1 To oFolder.Folders.Count  'サブフォルダーの数だけループする
        Call testFolder(strFolderName & " / " & oFolder.Name, x, oFolder.Folders.Item(c)) 'c番目のサブフォルダーを関数に渡す※自分
    Next

    '使用したオブジェクトの解放　= Nothing
    Set mITEM = Nothing
    
End Sub

※↑xで列 とか strFolderName を 渡して表示とかイラナカッタナぁ。