VBAでのOutlook自動操作

最終更新日：2019-06-16

VBAでのOutlook自動操作

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

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

VBAでメール送信する方法はいろいろありますがここではCDO(MicrosoftCollaborationDataObjects)を使っての送信方法を解説します。メール送信はメーラーを使う方法やフリーのDLLを使う方法等もありますがまずはWindowsに標準である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