Application_NewMailEx - Google 検索
URL省略
Outlook VBAなど
http://d.hatena.ne.jp/clock9/19820101
Outlook マクロ・スクリプト_インデックス«Outlook研究所
http://outlooklab.wordpress.com/outlook-macroscript-index/
Outlook VBA マクロ、はじめの一歩 « Outlook 研究所
URL省略
メールを受信するたびにメモに変換して保存するマクロ « Outlook 研究所
URL省略
受信したメールの添付ファイルを自動保存するマクロ « Outlook 研究所
URL省略
概略説明。以下、どこかから引用。
電子メール メッセージ、連絡先、タスクなどのアイテムを格納するフォルダーを表します。 Outlook には、16 の既定の MAPIFolder オブジェクトが用意されています。 Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox は、Outlook の [受信トレイ] フォルダーに対応します。
(引用元失念)
Option Explicit 'Excel2003 VBA から OutLook2003を起動して 受信メールを1つ1つ取り出す Sub OL_TEST_LOOK_MAIL_0221() Dim oApp As Object 'OutlookのApplication オブジェクトを入れる Dim myNameSpace As Object '名前のスペースと言われても、、 Dim myFolder As Object 'フォルダー指定 'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を Set oApp = CreateObject("Outlook.Application") '呪文1 名前空間 の 指定 と言っても、.GetNamespace("MAPI")しただけ Set myNameSpace = oApp.GetNamespace("MAPI") '次は作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display) Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定 myFolder.Display '表示 いつものクセで .Visible = True とやりがちだけど '次にメールの中身を取り出したいと思います。 Dim objMAILITEM As Object 'メールアイテム Dim n As Integer 'カウンター For n = 1 To myFolder.Items.Count 'フォルダーのアイテム数分ループ 'メールを1通取り出す、変数にセットする Set objMAILITEM = myFolder.Items(n) '別にあらためてセットしなくても使えるけど 'テストデータをセルにセットする※11行目からセットする。。。 Cells(n + 10, "A") = objMAILITEM.CreationTime '作成日 Cells(n + 10, "B") = objMAILITEM.SenderName '差出人 'Cells(n + 10, "C") = objMAILITEM.SenderEmailAddress '差出人のアドレス Cells(n + 10, "D") = objMAILITEM.Subject '件名 Cells(n + 10, "E") = objMAILITEM.Body '本文 Next n End Sub
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 If objDFld.Name = DATAFOLDER Then For Each objFld In objDFld.Folders 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