三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)


広告:


[記事一覧、バックナンバーを見る]

Outlook2007 VBA 再帰処理で全てのフォルダーに触ってみる

下記の質問をいただきました。


>OUTLOOKをエクセルで読み込むサンプルで
>二階層までのループを全階層のループにしたいのですがどうしたらいいのでしょうか?
>教えて頂けたら幸いです。

再帰処理※自分自身を呼ぶ関数で試しにOutlook2007で作成してみます。

folderオブジェクト(As Outlook.Folder)を受け取ったら、
受け取ったオブジェクトの名前 .Name

フォルダー内のアイテム .Items (ここではメールの件名.Subject)
を表示してみたいと思います。

と言っても、
Sub testFolder(oFolder As Outlook.Folder)
で、フォルダーを受け取ったら、
中身のITEMを表示後、
サブフォルダー .Folders(n) を再度 testFolderに渡しただけです。

コードといつもの怪しい実演販売(動作結果の動画)をみると、
流れがわかりやすいと思います。

Outlook2007 で テストしたコード

Sub main0328()

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

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

End Sub

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

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

    'テストで名前の表示
    Debug.Print oFolder.Name

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

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

    'サブフォルダーの処理
    For c = 1 To oFolder.Folders.Count  'サブフォルダーの数だけループする
        Call testFolder(oFolder.Folders.Item(c))  'c番目のサブフォルダーを関数に渡す
    Next

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

テスト結果

下記、怪しい実演(テスト結果です。)
Outlook2007 VBA 全てのフォルダーを再帰処理で触ってみた


終わりの挨拶

あっ、質問は
>OUTLOOKをエクセルで読み込むサンプルで
Excelで読み込むサンプルだった・・・
やばい、、、、

続きは

Outlook2007で作成したサンプルをExcel2007へ - ken3memo (三流君)
http://d.hatena.ne.jp/ken3memo/20120328/1332905188

を見て、笑ってください・・・

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

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

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

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

怪しい実演動画

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

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

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

作成したコード

参照設定後、
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 を 渡して表示とかイラナカッタナぁ。