Outlookのメールをエクセルに張り付ける
作成したプログラムを残すためにこの記事を書きました。
プログラム作成した際にお世話になりました。 1.VBAでoutlookのメールの内容を取得しているのですが、最新のメールのみを取得したい場合どのようにすれば良いでしょうか? detail.chiebukuro.yahoo.co.jp
2.エクセルVBAでOutlookの受信メールをワークシートに書き出す方法 tonari-it.com
がお世話なりました。
1.VBAでoutlookのメールの内容を取得しているのですが、最新のメールのみを取得したい場合どのようにすれば良いでしょうか? のプログラムを基準にプログラムを実行してみたところ Debug.Print .SenderName, .ReceivedTime, .Subject ではエクセルに張り付けることができない
そのため、 2.エクセルVBAでOutlookの受信メールをワークシートに書き出す方法 のプログラムを参考に、エクセルにデータを張り付ける With ThisWorkbook.Worksheets("Sheet1") .Cells(2, 1).Value = myInbox.Items(1).SentOn .Cells(2, 2).Value = myInbox.Items(1).Subject .Cells(2, 3).Value = myInbox.Items(1).Body End With
結果的に以下のプログラムになった。 ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Sub GetMail() Dim outlookObj As Object Dim myNameSpace As Object Dim objmailItem As Object Dim objmailItems As Object Dim SubFolder As Object Dim Target_mail As String Set outlookObj = CreateObject("Outlook.Application") Set myNameSpace = outlookObj.GetNamespace("MAPI") Set SubFolder = myNameSpace.GetDefaultFolder(6) '.Folders("").Folders("○○○○") Set objmailItems = SubFolder.Items objmailItems.Sort "[受信日時]", True 'False(昇順),True(降順) Set objmailItem = objmailItems(1) With objmailItem Cells(2, 1).Value = .SentOn Cells(3, 1).Value = .Subject Cells(4, 1).Value = .Body End With End Sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
最新のメールのみならず、目的の件名を探したいプログラムを付けたいと思い以下のものを作成した。 使用方法はA1に目的の件名を入力し、プログラムを実行する。 ーーーーーーーーーーーーーーーーーーーーーーーーー Sub GetMail2() Dim outlookObj As Object Dim myNameSpace As Object Dim objmailItem As Object Dim objmailItems As Object Dim SubFolder As Object Dim Target_mail As String Set outlookObj = CreateObject("Outlook.Application") Set myNameSpace = outlookObj.GetNamespace("MAPI") Set SubFolder = myNameSpace.GetDefaultFolder(6) '.Folders("").Folders("○○○○") Set objmailItems = SubFolder.Items objmailItems.Sort "[受信日時]", True 'False(昇順),True(降順) Target_mail = Range("A1").Value For i = 1 To 10 Set objmailItem = objmailItems(i) If objmailItem.Subject = Target_mail Then With objmailItem Cells(2, 1).Value = .SentOn Cells(3, 1).Value = .Subject Cells(4, 1).Value = .Body End With End If Next End Sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー