どうも、三流プログラマーのＫｅｎ３です。 今回は、 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 |
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 |
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 |
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 |
Private Sub btnCLOSE_Click()
Unload Me '自分自身を閉じます（笑）
End Sub |
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]