[三流君] −−＞ [VBAで楽しく] −−＞ [VBA Outlook 操作]
−−＞ No.171 Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る

Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る

発行内容

Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る

どうも、三流プログラマーのＫｅｎ３です。

今回は、
VBA から Outlook の受信トレイを探り、
メールアイテムのフラグを変更してみたいと思います。


/*
 * １. 今回のキッカケ
*/


掲示板にいただいた質問
---
>三流君VBAでOutlookを操作するの
>No.161 Outlook VBAでフラグ作成は非常にためになりました。
>私の場合は新規作成メールにフラグをつけるのではなく
>すでに受信しているメールに「実施済み」という意味合いでフラグを付けたい
>のですが、可能でしょうか
>よろしくお願いいたします。
---
と質問をもらった。

No.161 Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy
http://www.ken3.org/vba/backno/vba161.html
で行った方法は、新規に作成するメールに対してだったので一直線だったからなぁ。。

受信済みのメールを選択して、フラグを付けたいのね・・・


/*
 * ２．受信トレイの選択 .Foldersを探る
*/


フラグを付けるメールを選びたいよね。
とその前に、受信トレイとか送信トレイ、下書きなどのフォルダーの選択かぁ・・・

Excel VBA からOutLookデータを読む
http://www.ken3.org/guchi/backno/guchi022.html
↑愚痴系のNo.22 ナツカシイ・・

と過去の自分を参考にすると(Googleで探したら本人忘れてた自分のサイトを発見(笑))

.Foldersってオブジェクトで探れそうです。
フォルダー名をテストで表示させて見ました。


Sub aaa()
    'Outlookを開き、フォルダー名をメッセージボックスでテスト表示
    Dim objOL As Object      'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim n As Integer     'カウンター

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの数を表示する
    MsgBox "親のフォルダー数は" & objNAMESPC.Folders.Count

    'フォルダーの下、第二階層でループさせる
    For n = 1 To objNAMESPC.Folders(1).Folders.Count
        '1番目のさらに下、n番目のフォルダー名を表示する
        MsgBox objNAMESPC.Folders(1).Folders(n).Name
        Debug.Print objNAMESPC.Folders(1).Folders(n).Name
    Next n

    '後始末
    objOL.Quit

End Sub


実行すると、下記のフォルダー名が表示されると思います。

削除済みアイテム
受信トレイ
送信トレイ
送信済みアイテム
予定表
連絡先
履歴
メモ
仕事

手抜きで、
objNAMESPC.Folders(1).Folders(n)
と１番目のルートから２階層目を回してますが、
複数のアカウントを管理されている人は、注意が必要です・・・


/*
 * ３．フォルダーの下にメールアイテムが存在します
*/


パターン的にアカウント--フォルダー--メールアイテムって感じで探っていきます。
アカウントは、今回手抜きで、
objNAMESPC.Folders(1)と１番上のアカウントとして、
その下の受信トレイを探し（objNAMESPC.Folders(1).Folders(n)を探す）
そのフォルダー内のメールアイテムを探ってみます。


Sub bbb()
    '受信トレイを探し、メールの件名などを表示してみる
    'Outlookを開き、フォルダー名をメッセージボックスでテスト表示
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム
    Dim y As Integer     'カウンター

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか？
        If objFLD.Name = "受信トレイ" Then
            'テストでメールを新規ブックに書き出す
            Workbooks.Add   '新規ブックを作成する
            y = 1 '1行目から書き込む
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                'セルに代入
                Cells(y, "A") = objMAIL.CreationTime  '作成日
                Cells(y, "B") = objMAIL.Subject
                Cells(y, "C") = objMAIL.Body
                'セット位置を移動
                y = y + 1
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub


ポイントは、
For Each objFLD In objNAMESPC.Folders(1).Folders

Next
このループで、フォルダー(トレイ)をobjFLDに１つ１つ取り出しながらループさせます

次に、取り出したオブジェクトobjFLDの名前が受信トレイかチェックします。
If objFLD.Name = "受信トレイ" Then
と、.Nameプロパティを比較します。

フォルダー(トレイ)のItem数分(メールアイテム)を取り出すループを
  'フォルダーのアイテム数分ループ Folders.Items
  For Each objMAIL In objFLD.Items

  Next
と作成しました。このループでobjFLDのアイテム単位に処理してます。

あとは、テストなので、アイテムの内容を
  'セルに代入
  Cells(y, "A") = objMAIL.CreationTime  '作成日
  Cells(y, "B") = objMAIL.Subject
  Cells(y, "C") = objMAIL.Body
セルに代入しました。

テストプログラムでなんとなくイメージはつかめましたか？
受信トレイを.Nameを手がかりにフォルダーのループから探し、
その下のメールアイテム .Itemsから１件１件処理してます。


/*
 * ４．リストボックスに作成日、件名をセットする
*/


やっとメールアイテムまでたどり着けたので、
このアイテムに対してフラグを書き換えてみたいと思います。

と、その前に、データを選択しないといけないなぁ。
Excelのユーザーフォームを１つ作成して、リストボックスで選ばせるかな。

lstMAIL １つ、リストボックスを作成
btnSET , btnCLOSE ボタンを２つ作成

フォームを開いたタイミングで、
受信トレイの作成日時と件名をリストボックスにセットする。

リストボックスを選択後、btnSETボタンを押す
ボタンが押されたら、該当するメールアイテムを再度検索して、フラグをセット

btnCLOSEが押されたらフォームを閉じる、そんな処理を書いてみます。


まず、フォームが開かれたら、
Outlookの受信トレイからメールアイテムを取り込みます。


Private Sub UserForm_Initialize()
    'フォームの初期化イベントでリストボックスにメールデータをセットする
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム

    Dim strWORK As String

    Me.lstMAIL.Clear  '.Clearでリストボックスの内容を全てクリア

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか？
        If objFLD.Name = "受信トレイ" Then
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                '作成日:題名で文字列を作成する
                strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
                'データをセット
                Me.lstMAIL.AddItem (strWORK)
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub


ポイントは特に無く(オイオイ)
リストボックスを.Clearでクリアして、.AddItemで行を追加してます。
objMAIL.CreationTime & ":" & objMAIL.Subject
作成日:件名をリストボックスにセットしてます。(１つのカラムにセットしてます)

リストボックスの参考URLは
Excel UserForm リストボックスを使ってみた
http://www.ken3.org/vba/backno/vba121.html
を見てください。

ここからメインかな、
フラグをセットのボタンが押されたら、
^^^^^^^^^^^^^^
リストボックスで選択されている
作成日:題名 と一致するメールアイテムのフラグを書き換えます。


Private Sub btnSET_Click()
    'ボタンが押されたらリストボックスで選択されている
    'メールアイテムのフラグに実施済みの文字をセットする
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム

    Dim strWORK As String

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか？
        If objFLD.Name = "受信トレイ" Then
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                '作成日:題名で文字列を作成する
                strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
                'リストボックスとデータが一致するかチェック
                If Me.lstMAIL.Text = strWORK Then
                    'フラグデータをセット(書き換える)
                    objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で
                    objMAIL.FlagRequest = "実施済み" 'フラグ内容をセット
                    'objMAIL.FlagDueBy = Now '今回は期限はセットしない
                    objMAIL.Save  '忘れずに保存する
                    MsgBox "フラグメッセージを書き換えました"
                    Exit For 'ループを強制的に抜ける
                End If
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub


ほとんど、リストボックスの初期化と同様の処理で、
受信トレイを探してから、メールアイテムのループに入り、
  strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
  If Me.lstMAIL.Text = strWORK Then
で、リストボックスと文字が一致するかチェックしてます。
一致してたら、フラグのセットです
  objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で
  objMAIL.FlagRequest = "実施済み" 'フラグ内容をセット
  'objMAIL.FlagDueBy = Now '今回は期限はセットしない
  objMAIL.Save  '忘れずに保存する
ステータスに２、フラグ有りをセットしてから文字列で内容"実施済み"をセットします
そして忘れずに.Saveメソッドを発行して、保存します(私は忘れて小一時間悩みました)

メールのフラグ関係詳細は、
No.161 Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy
http://www.ken3.org/vba/backno/vba161.html
を見てください。

最後におまけの閉じるボタン

Private Sub btnCLOSE_Click()
    Unload Me   '自分自身を閉じます（笑）
End Sub


閉じるボタンの参考URLは
Excel Form 閉じる方法 Unload Me
http://www.ken3.org/vba/backno/vba061.html
を見てください。


/*
 * ５．終わりの挨拶
*/


今回は、
受信トレイの受信済みメールに対して、フラグをセットしてみた、
そんな話でした。

フォームを開いた時に全てのメールをリストボックスに代入してますが、
実際は、フラグがセットされていないメールのみをセットするのがよかったり。
※テストファイル作り終わってから気が付いたり・・・

  'フォルダーのアイテム数分ループ Folders.Items
  For Each objMAIL In objFLD.Items
     '作成日:題名で文字列を作成する
     strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
     'データをセット
     Me.lstMAIL.AddItem (strWORK) '←※１
  Next objMAIL

※１を
  If objMAIL.FlagRequest <> "実施済み" Then
    Me.lstMAIL.AddItem (strWORK)
  End If
と、
実施済み以外をリストで選択可能とすると便利かも。
~~~~~~~~~~~~
また、リストボックスで件名をクリックするとメールの内容が確認できたりしないと、
(リストボックスをクリックしたら、メールの中身を表示するなど)
不親切かなぁと思ったり。

いろいろとボロがあるサンプルですが、
http://www.ken3.org/vba/lzh/vba171.lzh
にサンプルvba171.xlsを圧縮しておきます、
Excel2000とOutlook2000版ですが使ってみてください。

三流君VBAでOutlookを操作する
http://www.ken3.org/cgi-bin/group/vba_outlook.asp
↑にVBA Outlook 操作系のメルマガまとめてます、こちらも一口どうぞ。
※今回、かなりの複合技だったけど、１つ１つはなれれば簡単かなぁ。

全体的に斬新なテクニック系のネタじゃないのですが、
何か、感じ取ってくれると、うれしいです。

ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。

フィードバック

VBA系の→[掲示板]←を覗く、質問を書き込む

評価・感想

No.171を読んだ満足度(評価)は？
5満足（参考になった）
4まぁまぁ（一部参考になった）
3普通（どちらとも言えない）
2なんかなぁ（期待と違った）
1不満（読んで損した気分）
 作者に感想・質問を送る場合は下記に気軽に書いてください
あなたのお名前（ニックネーム） さん

作者からの返信は、 不用 E-mail で受信したい
＊質問・感想はメルマガで紹介する場合があります

ページフッター(リンクや広告など)

[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列

書籍の購入

Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？

コンピュータ書籍の発送がハヤイ専門店

コンピュータの本・専門店
 ※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり

amazon.co.jpでキーワード別チェック

下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・