こんにちは。
先日、こちらのサイトのVisualBasicのカテゴリで質問したのですが、
1件アドバイスが入ったのに、表示されず、削除も出来ず
困ってしまったので、もう一度質問させていただきます。
タイトルの通りなのですが、
ExcelVBAで、OutLookの受信トレイの「未読」の件名、本文、受信時間を
Excelに一覧として落としたいのです。
いろいろサイトを見たりして、参考サイトで見つけたコードを
使って、思うとおりにカスタマイズしてもみたのですが、
どうしても思っていた通りには出来ませんでした。
上記やりたいことが出来るコード、参考サイトをご教示願えませんか?
ちなみに、OSはWindows2002です。
どうぞよろしくお願い致します。
No.4ベストアンサー
- 回答日時:
#1 です。
こちらとしては、どなたが解決してもかまいませんので、ずるいようですが、#2,#3 で書かれているname_mm_ok 様のコードで様子を見させていただきます。
なお、
>セキュリティ関連のダイアログが開き、アクセス可能な時間を選択
>する必要がある事です。
>この件に関しては、私のレベルでは回避不可能でした。
Faq ですが、一応、セキュリティレベルなので、Outlook では、解決は出来ないというのが、一般的な回答です。他は知りません。
なお、
.UnRead = True
で、私の回答は、逆に書いてしまいました。間違えました。
再度のアドバイスありがとうございます!!
せっかくアドバイス頂いたのに、お礼が遅くなってしまってごめんなさい!!!
ちょっと別件で忙しくなってしまい、こちらは保留となっておりました。
お二人に頂いたアドバイスを元に、頑張ってやってみます。
まだ保留状態で、実動できる状態ではないので、結果報告が出来ないのですが
これ以上遅くなってしまうと申し訳ないので、一旦ここで閉じようと思います。
今後はもっと勉強して、今度は自分が誰かの質問に答えられるようになりたいと思います。
本当にありがとうございました!!!
またよろしければ、ご教示くださいね。
お礼に関しては、まだ結果が出ていない状態なので
勝手ですが順番に付けさせてください。
失礼でしたら申し訳ございません。
No.3
- 回答日時:
これが、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
アドバイスありがとうございます!!
せっかくアドバイスいただいたのに、お礼が遅くなってしまい
本当に申し訳ございません!!!
ちょっと別件で忙しくなってしまい、こちらはいったん保留となっておりました。
詳しいコードをありがとうございます。
まだ、実動できてはいないのですが
このコードを解読して、頑張ってみたいと思います。
もっと勉強して、私も誰かの質問に答えられるようになりたいとおもいます。
本当にありがとうございました!
またどうしても解らないことがありましたら、ぜひご教示ください。
No.2
- 回答日時:
VisualBasicでご質問された際のコードを確認しました。
追加行(1~3)とコメントしている行の追加及び、追加行のXXXを取得したいフォルダの名称に変更し、Wendy02 様が回答されている未読メールの判定を For Each objItem ~ のループ内に挿入すれば動作すると思います。
今のPCにはOutlookがインストールされていないため、動作しないようであれば、その旨回答への補足を頂ければ、動作確認可能な環境で確認後再度回答致します。
今後のためにも、オブジェクトブラウザ、ブレイク、ウォッチ等、VBAの動作確認する際の方法について調べられたほうがいいかと思います。
For nFCNT = 1 To olNameSPC.Folders(1).Folders.Count
'イミディエイトウィンドウにフォルダ名称が出力されます。
'この行は現在取得可能な正しいフォルダ名称を確認後削除して下さい。
debug.print olNameSPC.Folders(1).Folders(nFCNT).Name
if olNameSPC.Folders(1).Folders(nFCNT).Name = "受信トレイ" Then '追加行(1)
'フォルダーの名称を書き込む
Cells(nYLINE, 1) = olNameSPC.Folders(1).Folders(nFCNT).Name
nYLINE = nYLINE + 1
'見出しを書き込む
Cells(nYLINE, 1) = "No."
Cells(nYLINE, 2) = "タイプ"
Cells(nYLINE, 3) = "作成日"
Cells(nYLINE, 4) = "件名"
Cells(nYLINE, 5) = "内容"
nYLINE = nYLINE + 1
'メッセージ数分ループ
For Each objItem In olNameSPC.Folders(1).Folders(nFCNT).Items
intCounter = intCounter + 1
'変数に代入(セルに直接でもいいかも?)
With objItem
dteCreateDate = .CreationTime
strSubject = .Subject
strItemType = TypeName(objItem)
strBody = .Body
End With
'セルに代入
Cells(nYLINE, 1) = intCounter
Cells(nYLINE, 2) = strItemType
Cells(nYLINE, 3) = dteCreateDate
Cells(nYLINE, 4) = strSubject
Cells(nYLINE, 5) = strBody
'セット位置を移動
nYLINE = nYLINE + 1
Next objItem
exit for '追加行(2)
end if '追加行(3)
No.1
- 回答日時:
こんばんは。
VBカテゴリでは、その1件は、削除されてしまったようです。
たぶん、ここの部分では?
>Set olAPP = CreateObject("Outlook.Application")
>Set olNameSPC = olAPP.GetNamespace("MAPI") ' Namespace オブジェクト
>
>nYLINE = 1
>For nFCNT = 1 To olNameSPC.Folders(1).Folders.Count '←ここの部分
いきなりMapiの名前空間ではなくて、もう一度フォルダを取り直したらどうでしょうか?今、コードを動かしているわけではないので、あまり断定的に言えませんが。
Set olNameSPC = olAPP.GetNamespace("MAPI") ' Namespace オブジェクト
Set myFolder = olNameSPC.GetDefaultFolder(6) 'olFolderInbox
For nFCNT =1 to myFolder.Items.Count
>OutLookの受信トレイの「未読」の件名
>という件に関しては、
If myFolder.Items(i).UnRead = False Then
で、未読のフラグを、取れるはずです。
この回答への補足
さっそくのお返事ありがとうございます。
そして、いつもご教示いただき、ありがとうございます。
現在、Wendy02さまのアドバイスに沿って、コードを見直しているのですが、
まだうまく動作できません。
もう少し頑張ってみますので、お礼&締め切りはお待ち下さい。
思い通りの動作が出来たら、ここにアップして締め切りたいと思います。
もし、お手すきでしたら再度アドバイスして頂けたら嬉しいです。
本当にいつもありがとうございます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
サンダーバードで受信した複数...
-
メールソフトthunderbirdの「フ...
-
[outlook]起動するとフォルダが...
-
Thunderbirdのフォルダ移動が出...
-
outlook受信トレイのフォルダー...
-
Outlookで2週間以上前のメール...
-
LINEに貰った写真、直接SDカー...
-
メールアドレスで 中段・下段...
-
キーボードのハイフンの出しかた
-
Thunderbirdのアドレス帳の表示...
-
XP→Win8へのメール移行
-
Thunderbirdの連絡先をコピーし...
-
アドレス帳で自由に設定した表...
-
OEからMicrosoft Outlookへア...
-
遠く離れた相手に150MBのデータ...
-
outlookの日本語フォントと半角...
-
Outlookで宛先に敬称をつけたい...
-
アドレス帳の登録名を相手に知...
-
Outlookのインポートしたアドレ...
-
【 Windows 10 】アドレス帳に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
サンダーバードで受信した複数...
-
メールソフトthunderbirdの「フ...
-
Thunderbirdのフォルダ移動が出...
-
outlook受信トレイのフォルダー...
-
Thunderbirdで受信フォルダのメ...
-
Lotus notesでの新規フォルダ...
-
[outlook]起動するとフォルダが...
-
メールの並び替え
-
Becky!2のIMAPフォルダについて...
-
ノートン アンチスパム スパ...
-
ヤフーメールで、あるタイトル...
-
EDMAXについて詳しい方お...
-
Outlook2000/2003 サブフォルダ...
-
アウトルックのフォルダの移動...
-
メールのデータ移行について
-
アウトルックのメールですが、...
-
Outlook Express 6の操作に慣れ...
-
受信したメールをフォルダーに...
-
LINEに貰った写真、直接SDカー...
-
Outlookで2週間以上前のメール...
おすすめ情報