VBAでのOutlook自動操作

最終更新日：2014-07-08

VBAでのOutlook自動操作

エクセルでメールの送受信する方法はいくつかありますが、

なかなか面倒ですし、サポートされない機能（CDOは送信のみ）があったりと、不便な事が多いです。

そこで、Excelを使っていると言う事は、大抵はOutlookもインストールされているはずですので、

これを使って、メールの送受信を行うという選択をすることは自然な流れです。

以下では、ExcelからVBAでOutlookを自動操作して、メールの送受信をする場合のサンプルになります。

私自信の覚書の意味で掲載しますので、解説はあまりなく、多くのサンプルコードを掲載いたします。

VBAコード自体は、難しいものではないので、コードを見るだけで理解できるはずです。

Outlookインスタンスの生成と、ログオン、全て送受信

Sub sample1()
　　Dim oApp As New Outlook.Application
　　Call oApp.Session.LogOn("Outlook", "")
　　Call oApp.Session.SendAndReceive(True)
　　oApp.Quit
　　Set oApp = Nothing
End Sub

※参照設定で、
　　Microsoft Outlook 15.0 Object Library
　　（バージョンは各PCに合わせて設定して下さい。）
　　を設定して下さい。
　　CreateObject("Outlook.Application")
　　でも良いのですが、なるべく事前バインディングするようにしましょう。

フォルダーの取得

Sub sample2()
　　Dim oApp As New Outlook.Application
　　Dim oNamespace As Outlook.Namespace
　　Dim oFolder As Outlook.Folder
　　Dim i As Long
　　Set oNamespace = oApp.GetNamespace("MAPI")
　　i = 1
　　For Each oFolder In oNamespace.Folders
　　　　Cells(i, 1) = oFolder.Name
　　　　i = i + 1
　　Next
　　Set oFolder = Nothing
　　Set oNamespace = Nothing
　　Set oApp = Nothing
End Sub

ここでのGetNamespaceは、"MAPI"のみです。
そして、これは、Sessionと同一になりますので、以下と同じことになります。

Sub sample3()
　　Dim oApp As New Outlook.Application
　　Dim oFolder As Outlook.Folder
　　Dim i As Long
　　i = 1
　　For Each oFolder In oApp.Session.Folders
　　　　Cells(i, 1) = oFolder.Name
　　　　i = i + 1
　　Next
　　Set oFolder = Nothing
　　Set oApp = Nothing
End Sub

上記は、Outlookのルート直下のみ取得しています。
Folder内のサブフォルダーを取得する場合は、
oFolder.Folders
より取得可能です。

全フォルダーを取得するなら、以下のように再起呼び出しが必要になります。

Sub sample4()
　　Dim oApp As New Outlook.Application
　　Dim oFolder As Outlook.Folder
　　Dim i As Long
　　Dim j As Long
　　i = 1
　　For Each oFolder In oApp.Session.Folders
　　　　j = 1
　　　　Cells(i, j) = oFolder.Name
　　　　i = i + 1
　　　　Call sample4_sub(oFolder, i, j)
　　Next
　　Set oFolder = Nothing
　　Set oApp = Nothing
End Sub
Sub sample4_sub(ByVal oFolder As Outlook.Folder, ByRef i As Long, ByVal j As Long)
　　j = j + 1
　　For Each oFolder In oFolder.Folders
　　　　Cells(i, j) = oFolder.Name
　　　　i = i + 1
　　　　Call sample4_sub(oFolder, i, j)
　　Next
End Sub

メールの一覧を取得

Sub sample5()
　　Dim oApp As New Outlook.Application
　　Dim oFolder As Outlook.Folder
　　Dim oItem As Outlook.MailItem
　　Dim i As Long
　　Dim j As Long
　　Set oFolder = oApp.Session.Folders("Outlook データファイル").Folders("受信保存").Folders("×××")
　　i = 1
　　For Each oItem In oFolder.Items
　　　　Cells(i, 1) = oItem.ReceivedTime
　　　　Cells(i, 2) = oItem.SenderName
　　　　Cells(i, 3) = oItem.Subject
　　　　Cells(i, 4) = oItem.Body
　　　　For j = 1 To oItem.Attachments.Count
　　　　　　Cells(i, j + 4) = oItem.Attachments.Item(j).FileName
　　　　　　'保存する場合は
　　　　　　'oItem.Attachments.Item(j).SaveAsFile Path:="フルパス"
　　　　Next
　　　　i = i + 1
　　Next
　　Set oItem = Nothing
　　Set oFolder = Nothing
　　Set oApp = Nothing
End Sub

通常は、処理したいフォルダーはきまっているはずですので、
上記のように、Foldersにフォルダー名を指定して特定すれば簡単です。

メールを送信

Sub sample6()
　　Dim oApp As New Outlook.Application
　　Dim oItem As Outlook.MailItem
　　Set oItem = oApp.CreateItem(olMailItem)
　　
　　oItem.To = "Toメールアドレス"
　　oItem.CC = "CCメールアドレス"
　　oItem.BCC = "BCCメールアドレス"
　　oItem.Subject = "件名"
　　oItem.Importance = olImportanceHigh
　　oItem.Attachments.Add "添付フルパス"
　　oItem.Body = "本文"
　　oItem.Send
　　'送信せずに画面を表示する場合は、
　　'oItem.Display
　　Set oItem = Nothing
　　Set oApp = Nothing
End Sub

CreateItem
で作成すれば、後は、各プロパティへの設定だけです。
VBAテスト中は、いきなりSendせずに、Displayして確認すると良いでしょう。

メールを返信

Sub sample7()
　　Dim oApp As New Outlook.Application
　　Dim oFolder As Outlook.Folder
　　Dim oItem As Outlook.MailItem
　　Dim rItem As Outlook.MailItem
　　Dim i As Long
　　Dim j As Long
　　Set oFolder = oApp.Session.Folders("Outlook データファイル").Folders("受信保存").Folders("×××")
　　For Each oItem In oFolder.Items
　　　　If oItem.UnRead Then
　　　　　　Set rItem = oItem.Reply
　　　　　　oItem.UnRead = False
　　　　　　rItem.Body = "メール受け取りました。"
　　　　　　rItem.Send
　　　　　　Exit For
　　　　End If
　　Next
　　Set oItem = Nothing
　　Set oFolder = Nothing
　　Set oApp = Nothing
End Sub

Replyは、全員へ返信のRplyAllもあります。
添付等、他はsample6と同様になります。

メールに関しては、これくらいで大抵は事足りるでしょう。
予定表等についても、VBAで操作可能です。
どんなオブジェト・プロパティがあるかを調べる事が少々面倒ですが、
VBAコード自体は、いたってシンプルに実現できるはずです。