Outlook VBA:コードの基本

いくつかの例を用いて、Outlook VBAの基本を解説します。

目次

Outlookの受信メールをVBAで取得する方法

受信したメールに何らかの操作をする場合、まず受信トレイなどのフォルダを取得するところから始めます。

以下のサンプルコードでは、受信トレイを取得した後、イミディエイトウィンドウに件名を表示してます。

Private Function GetMailItems() As outlook.Items
    'Outlookの機能にアクセスするためのMAPIオブジェクトを取得
    Dim ns As Outlook.NameSpace
    Set ns = Outlook.Application.GetNamespace("MAPI")
    
    '受信トレイのフォルダーオブジェクトを取得
    Dim myFld As Outlook.Folder
    Set myFld = ns.GetDefaultFolder(olFolderInbox)
    
    'メールアイテムを取得する
    Dim myItem As Outlook.MailItem
    For Each myItem In myFld.Items
        'サンプルとしてイミディエイトウィンドウに件名を表示
        Debug.Print myItem.Subject
    Next
End Function

解説

上記は、3つの手順でメールの内容を取得しています。

  • Outlookの機能にアクセスするためのMAPIオブジェクトを取得
  • 受信トレイのフォルダーオブジェクトを取得
  • メールアイテムを取得する

順にみていきましょう。

手順1: Outlookの機能にアクセスするためのMAPIオブジェクトを取得

'Outlookの機能にアクセスするためのMAPIオブジェクトを取得
Dim ns As Outlook.NameSpace
Set ns = Outlook.Application.GetNamespace("MAPI")

なお、MAPIとは、以下のとおり。

MAPIとは、Messaging Application Programming Interfaceの略。
米マイクロソフト(Microsoft)社が策定したソフトウェア部品間の標準的な呼び出し規約(API)の一つで、電子メールなどのメッセージの送受信や管理などの機能にアクセスするためのもの。同社のOutlookや Exchange Serverで用いられている。

https://e-words.jp/w/MAPI.html
hideharu

MAPIを使用することでOutlookの各種機能にアクセスできる!

手順2: 受信トレイのフォルダーオブジェクトを取得

先ほど取得したNameSpaceを使って受信トレイフォルダのオブジェクトを取得します。

'受信トレイのフォルダーオブジェクトを取得
Dim myFld As Outlook.Folder
Set myFld = ns.GetDefaultFolder(olFolderInbox)

ns.GetDefaultFolder(olFolderInbox)で受信トレイフォルダを取得してOutlook.Folder型のmyFld変数を格納しています。

>> GetDefaultFolderメソッド

引数のolFolderInbox受信トレイフォルダを取得するための指定になっていて、他にも送信トレイを取得するにはolFolderOutbox連絡フォルダーを指定するにはolFolderContactsといった指定ができます。

他にも様々な指定ができます。詳しくは、公式ページをご覧ください。
>> OlDefaultFolders 列挙 (Outlook)

手順3: メールアイテムを取得する

受信トレイまで取得できたので、最後にメールを取得します。

'メールアイテムを取得する
Dim myItem As Outlook.MailItem
For Each myItem In myFld.Items
    'サンプルとしてイミディエイトウィンドウに件名を表示
    Debug.Print myItem.Subject
Next

上記サンプルではmyFld.Items(i).Subjectと指定しており、メールの件名を取得しています。

他のプロパティは以下のとおり。

プロパティ内容
Subjectメールの件名
Toメールの宛先
CCメールのCC
Body本文
ReceivedTimeアイテムが受信された日時

>> MailItem オブジェクト (Outlook)

上記の方法では、受信トレイ内のメールを取得できますが、サブフォルダに入っているメールの情報を取得することができません。

全階層のメールを取得する方法

やりたいこと
  • Outlookで実行するVBAマクロ
  • 受信フォルダ名の中にあるメールに対して、件名をすべてイミディエイトウィンドウに出力する
  • 検索対象のメールは、受信フォルダ名の直下だけでなく、受信フォルダ内にある全ての階層のフォルダ内のメールとする

サンプルコードは以下のとおり。

Sub PrintAllEmailSubjectsInInbox()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.Folder

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Namespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox)
    
    ' 受信フォルダ内の全てのフォルダを再帰的に検索し、メールの件名を出力
    Call PrintEmailSubjectsInFolder(Inbox)
    
    ' オブジェクトの解放
    Set Inbox = Nothing
    Set Namespace = Nothing
    Set OutlookApp = Nothing
End Sub

Sub PrintEmailSubjectsInFolder(Folder As Outlook.Folder)
    Dim MailItem As Object
    Dim SubFolder As Outlook.Folder
    
    ' フォルダ内のアイテムをループ
    For Each MailItem In Folder.Items
        ' メールがMailItemであることを確認
        If TypeOf MailItem Is Outlook.MailItem Then
            ' メールの件名をイミディエイトウィンドウに出力
            Debug.Print MailItem.Subject
        End If
    Next MailItem
    
    ' サブフォルダをループして再帰的に検索
    For Each SubFolder In Folder.Folders
        Call PrintEmailSubjectsInFolder(SubFolder)
    Next SubFolder
End Sub

このコードを実行すると、受信フォルダ内のすべての階層を再帰的に検索し、各フォルダ内のメールの件名をイミディエイトウィンドウに出力します。再帰的にサブフォルダを検索することで、すべての階層が対象となります。

受信フォルダを指定してメールを取得する方法

受信フォルダ直下のフォルダを指定する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 指定された受信フォルダ名の中にあるメールの件名を、VBAのイミディエイトウィンドウに出力する

サンプルコードは以下のとおり。

Sub PrintEmailSubjectsFromSpecifiedFolder()

    ' 受信フォルダ名を指定
    Dim folderName As String
    folderName = "受信フォルダ名をここに入力" ' 例: "Inbox" または "サブフォルダ名"
    
    ' Outlookオブジェクトを宣言
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olMail As Outlook.MailItem
    Dim i As Integer
    
    ' Outlookアプリケーションと名前空間を取得
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' 指定されたフォルダを取得
    On Error Resume Next
    Set olFolder = olNamespace.Folders.Item("受信トレイ").Folders(folderName)
    On Error GoTo 0
    
    ' フォルダが見つからない場合のエラーメッセージ
    If olFolder Is Nothing Then
        MsgBox "指定されたフォルダが見つかりません。", vbExclamation
        Exit Sub
    End If
    
    ' フォルダ内のアイテムを取得
    Set olItems = olFolder.Items
    
    ' フォルダ内のメールアイテムをループ
    For i = 1 To olItems.Count
        If TypeName(olItems(i)) = "MailItem" Then
            Set olMail = olItems(i)
            ' イミディエイトウィンドウに件名を出力
            Debug.Print olMail.Subject
        End If
    Next i

    ' オブジェクトを解放
    Set olMail = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing

End Sub

2階層以上のフォルダを指定する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 指定された受信フォルダ名の中にあるメールに対して、件名をすべてイミディエイトウィンドウに出力する
  • 指定された受信フォルダとは、たとえば、受信フォルダの中の「製品」フォルダの中の「コンシューマー」フォルダのように、2階層下になっている

サンプルコードは以下のとおり。

Sub DisplayEmailSubjectsInFolder()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.Folder
    Dim TargetFolder As Outlook.Folder
    Dim MailItem As Outlook.MailItem
    Dim FolderPath As String
    Dim FolderArray() As String
    Dim i As Integer

    ' フォルダパスの指定(例: 受信フォルダ/製品/コンシューマー)
    FolderPath = "受信トレイ\製品\コンシューマー"

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Namespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox)
    
    ' フォルダパスを配列に変換
    FolderArray = Split(FolderPath, "\")

    ' フォルダの取得
    Set TargetFolder = Inbox
    For i = 1 To UBound(FolderArray)
        Set TargetFolder = TargetFolder.Folders(FolderArray(i))
        If TargetFolder Is Nothing Then
            Debug.Print "フォルダが見つかりません: " & FolderArray(i)
            Exit Sub
        End If
    Next i

    ' メール情報の出力
    For Each Item In TargetFolder.Items
        If TypeName(Item) = "MailItem" Then
            Set MailItem = Item
            Debug.Print "メールの件名: " & MailItem.Subject
        End If
    Next Item

    ' オブジェクトの解放
    Set MailItem = Nothing
    Set TargetFolder = Nothing
    Set Inbox = Nothing
    Set Namespace = Nothing
    Set OutlookApp = Nothing
End Sub

以下は、上記のコードに対して、エラー処理を追加したもの。

Sub DisplayEmailSubjectsInFolderWithErrorHandling()
    On Error GoTo ErrorHandler

    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.Folder
    Dim TargetFolder As Outlook.Folder
    Dim MailItem As Outlook.MailItem
    Dim FolderPath As String
    Dim FolderArray() As String
    Dim i As Integer

    ' フォルダパスの指定(例: 受信フォルダ/製品/コンシューマー)
    FolderPath = "受信トレイ\製品\コンシューマー"

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Namespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox)
    
    ' フォルダパスを配列に変換
    FolderArray = Split(FolderPath, "\")

    ' フォルダの取得
    Set TargetFolder = Inbox
    For i = 1 To UBound(FolderArray)
        Set TargetFolder = TargetFolder.Folders(FolderArray(i))
        If TargetFolder Is Nothing Then
            Debug.Print "フォルダが見つかりません: " & FolderArray(i)
            Exit Sub
        End If
    Next i

    ' メール情報の出力
    For Each Item In TargetFolder.Items
        If TypeName(Item) = "MailItem" Then
            Set MailItem = Item
            Debug.Print "メールの件名: " & MailItem.Subject
        End If
    Next Item

    ' オブジェクトの解放
    Set MailItem = Nothing
    Set TargetFolder = Nothing
    Set Inbox = Nothing
    Set Namespace = Nothing
    Set OutlookApp = Nothing
    Exit Sub

ErrorHandler:
    Debug.Print "エラーが発生しました: " & Err.Description
    ' オブジェクトの解放
    If Not MailItem Is Nothing Then Set MailItem = Nothing
    If Not TargetFolder Is Nothing Then Set TargetFolder = Nothing
    If Not Inbox Is Nothing Then Set Inbox = Nothing
    If Not Namespace Is Nothing Then Set Namespace = Nothing
    If Not OutlookApp Is Nothing Then Set OutlookApp = Nothing
End Sub

エラー処理については以下をご覧ください。

全階層のなかでフォルダを指定する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 指定された受信フォルダ名の中にあるメールに対して、件名をすべてイミディエイトウィンドウに出力する
  • 指定された受信フォルダとは、「コンシューマー」というフォルダ名。
  • 指定された受信フォルダは、受信フォルダ名の直下にあるとは限らないので、受信フォルダ内にある全ての階層のフォルダを検索すること。

サンプルコードは以下のとおり。

Sub PrintAllEmailSubjectsInConsumerFolder()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.Folder
    
    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Namespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox)
    
    ' 「コンシューマー」フォルダを受信トレイ内の全階層から検索
    Call SearchFolder(Inbox, "コンシューマー")
    
    ' オブジェクトの解放
    Set Inbox = Nothing
    Set Namespace = Nothing
    Set OutlookApp = Nothing
End Sub

Sub SearchFolder(Folder As Outlook.Folder, FolderName As String)
    Dim SubFolder As Outlook.Folder
    Dim TargetFolder As Outlook.Folder
    
    ' 現在のフォルダが対象のフォルダ名と一致するか確認
    If Folder.Name = FolderName Then
        Set TargetFolder = Folder
        ' 対象のフォルダ内の全てのメールの件名を出力
        Call PrintEmailSubjects(TargetFolder)
    End If
    
    ' サブフォルダをループして再帰的に検索
    For Each SubFolder In Folder.Folders
        Call SearchFolder(SubFolder, FolderName)
    Next SubFolder
End Sub

Sub PrintEmailSubjects(Folder As Outlook.Folder)
    Dim MailItem As Object
    
    ' フォルダ内のアイテムをループ
    For Each MailItem In Folder.Items
        ' メールがMailItemであることを確認
        If TypeOf MailItem Is Outlook.MailItem Then
            ' メールの件名をイミディエイトウィンドウに出力
            Debug.Print MailItem.Subject
        End If
    Next MailItem
End Sub

上記のコードを実行すると、受信トレイ内の全ての階層を検索して「コンシューマー」というフォルダを見つけ、そのフォルダ内の全てのメールの件名をイミディエイトウィンドウに出力します。再帰的にサブフォルダを検索することで、全ての階層が対象となります。

アクティブになっているメールを取得する方法

やりたいこと
  • Outlookで実行するVBAマクロ
  • 選択された(アクティブになっている)メールのタイトルを、イミディエイトウィンドウに出力する

サンプルコードは以下のとおり。

Sub DisplaySelectedEmailSubject()
    ' Outlookアプリケーションオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim SelectedMail As Outlook.MailItem
    
    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    
    ' 選択されたアイテムがメールであることを確認
    If OutlookApp.ActiveExplorer.Selection.Count > 0 Then
        If TypeName(OutlookApp.ActiveExplorer.Selection.Item(1)) = "MailItem" Then
            Set SelectedMail = OutlookApp.ActiveExplorer.Selection.Item(1)
            ' イミディエイトウィンドウにタイトルを出力
            Debug.Print "選択されたメールのタイトル: " & SelectedMail.Subject
        Else
            Debug.Print "選択されたアイテムはメールではありません。"
        End If
    Else
        Debug.Print "メールが選択されていません。"
    End If
    
    ' オブジェクトの解放
    Set SelectedMail = Nothing
    Set OutlookApp = Nothing
End Sub

アクティブになっているメールを取得した後に特定のフォルダに移動する方法

やりたいこと
  • Outlookで実行するVBAマクロ
  • 選択された(アクティブになっている)メールのタイトルを、イミディエイトウィンドウに出力する
  • 上記処理の後に、そのメールを特定のフォルダに移動する
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

サンプルコードは以下のとおり。

Sub MoveSelectedMailToFolder()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim SelectedMail As Outlook.MailItem
    Dim Inbox As Outlook.Folder
    Dim ProductFolder As Outlook.Folder
    Dim ConsumerFolder As Outlook.Folder

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application

    ' 選択されたメールを取得
    On Error Resume Next
    Set SelectedMail = OutlookApp.ActiveExplorer.Selection.Item(1)
    On Error GoTo 0

    ' 選択されたアイテムがメールであることを確認
    If Not SelectedMail Is Nothing Then
        ' 選択されたメールの件名をイミディエイトウィンドウに出力
        Debug.Print "選択されたメールの件名: " & SelectedMail.Subject

        ' 受信トレイフォルダの取得
        Set Inbox = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
        ' 「製品」フォルダの取得
        Set ProductFolder = Inbox.Folders("製品")
        ' 「コンシューマー」フォルダの取得
        Set ConsumerFolder = ProductFolder.Folders("コンシューマー")

        ' メールを「コンシューマー」フォルダに移動
        SelectedMail.Move ConsumerFolder

        MsgBox "メールを「コンシューマー」フォルダに移動しました。", vbInformation
    Else
        MsgBox "メールを選択してください。", vbExclamation
    End If

    ' オブジェクトの解放
    Set SelectedMail = Nothing
    Set ConsumerFolder = Nothing
    Set ProductFolder = Nothing
    Set Inbox = Nothing
    Set OutlookApp = Nothing
End Sub

特定のメールを表示させる方法

前提
  • Outlookには、受信フォルダの直下にメールがある。
  • 受信フォルダには、2階層以上のフォルダがあり、それぞれのフォルダにもメールがある。
やりたいこと
  • Outlookで実行するVBAマクロ
  • 受信フォルダの中にある全ての階層のメールに対して、
    -「未読」かつ
    -「メールの本文に”田中”という文字が含まれている」
    ものを検索する
  • 上記の条件に合致するメールが1つでもあったら検索を終了し、そのメールを表示させる。

サンプルコードは以下のとおり。

Sub SearchUnreadEmailsWithKeyword()
    Dim ns As Outlook.Namespace
    Dim inbox As Outlook.Folder
    Dim mail As Outlook.MailItem
    Dim foundMail As Outlook.MailItem
    
    ' Outlookの名前空間を取得
    Set ns = Application.GetNamespace("MAPI")
    ' 受信フォルダを取得
    Set inbox = ns.GetDefaultFolder(olFolderInbox)
    
    ' 受信フォルダ内の全ての階層を検索
    Set foundMail = SearchFolders(inbox)
    
    ' 条件に合致するメールが見つかった場合、それを表示
    If Not foundMail Is Nothing Then
        foundMail.Display
    Else
        MsgBox "条件に合致するメールは見つかりませんでした。"
    End If
End Sub

Function SearchFolders(ByVal folder As Outlook.Folder) As Outlook.MailItem
    Dim subFolder As Outlook.Folder
    Dim item As Object
    Dim mail As Outlook.MailItem
    
    ' フォルダ内の全てのアイテムをチェック
    For Each item In folder.Items
        ' アイテムがメールの場合
        If TypeName(item) = "MailItem" Then
            Set mail = item
            ' 未読かつ本文に"田中"を含む場合
            If mail.UnRead And InStr(mail.Body, "田中") > 0 Then
                Set SearchFolders = mail
                Exit Function
            End If
        End If
    Next item
    
    ' サブフォルダを再帰的にチェック
    For Each subFolder In folder.Folders
        Set SearchFolders = SearchFolders(subFolder)
        ' 条件に合致するメールが見つかった場合
        If Not SearchFolders Is Nothing Then
            Exit Function
        End If
    Next subFolder
    
    ' 条件に合致するメールが見つからない場合
    Set SearchFolders = Nothing
End Function

説明

  • SearchUnreadEmailsWithKeyword サブルーチンは、Outlookの受信フォルダとそのサブフォルダを再帰的に検索します。
  • SearchFolders 関数は、各フォルダ内のメールをチェックし、未読かつ本文に「田中」という文字が含まれているメールを見つけた場合、そのメールを返します。
  • メールが見つかると、foundMail 変数にそのメールが設定され、foundMail.Display によってメールが表示されます。
  • メールが見つからない場合は、メッセージボックスで通知します。

特定のメールを特定のフォルダに移動する方法

送信者で検索する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 特定のメールを特定のフォルダに移動する
  • 特定のメールとは、送信者が「sender@example.com」であること
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

サンプルコードは以下のとおり。

Sub MoveSpecificEmailsToFolder()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Inbox As Outlook.Folder
    Dim ProductFolder As Outlook.Folder
    Dim ConsumerFolder As Outlook.Folder
    Dim MailItem As Outlook.MailItem
    Dim i As Integer

    ' 送信者のメールアドレス
    Dim SpecificSender As String
    SpecificSender = "sender@example.com"

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Inbox = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set ProductFolder = Inbox.Folders("製品")
    Set ConsumerFolder = ProductFolder.Folders("コンシューマー")

    ' 受信トレイ内のすべてのメールをチェック
    For i = Inbox.Items.Count To 1 Step -1
        If TypeName(Inbox.Items(i)) = "MailItem" Then
            Set MailItem = Inbox.Items(i)
            ' 指定された送信者のメールをチェック
            If MailItem.SenderEmailAddress = SpecificSender Then
                ' メールを「コンシューマー」フォルダに移動
                MailItem.Move ConsumerFolder
            End If
        End If
    Next i

    MsgBox "指定された送信者のメールを「コンシューマー」フォルダに移動しました。", vbInformation

    ' オブジェクトの解放
    Set MailItem = Nothing
    Set ConsumerFolder = Nothing
    Set ProductFolder = Nothing
    Set Inbox = Nothing
    Set OutlookApp = Nothing
End Sub

メール件名で検索する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 特定のメールを特定のフォルダに移動する
  • 特定のメールとは、メール件名「製品リリース」が含まれること
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

サンプルコードは以下のとおり。

Sub MoveProductReleaseMails()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Inbox As Outlook.Folder
    Dim ProductFolder As Outlook.Folder
    Dim ConsumerFolder As Outlook.Folder
    Dim MailItem As Outlook.MailItem
    Dim i As Integer

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Inbox = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set ProductFolder = Inbox.Folders("製品")
    Set ConsumerFolder = ProductFolder.Folders("コンシューマー")

    ' 受信トレイ内のメールをループして「製品リリース」が含まれるメールを特定
    For i = Inbox.Items.Count To 1 Step -1
        If TypeOf Inbox.Items(i) Is Outlook.MailItem Then
            Set MailItem = Inbox.Items(i)
            If InStr(MailItem.Subject, "製品リリース") > 0 Then
                ' メールを「コンシューマー」フォルダに移動
                MailItem.Move ConsumerFolder
            End If
        End If
    Next i

    ' オブジェクトの解放
    Set MailItem = Nothing
    Set ConsumerFolder = Nothing
    Set ProductFolder = Nothing
    Set Inbox = Nothing
    Set OutlookApp = Nothing

    MsgBox "件名に「製品リリース」が含まれるメールを移動しました。", vbInformation
End Sub

メール本文で検索する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 特定のメールを特定のフォルダに移動する
  • 特定のメールとは、メール本文「製品リリース」が含まれること
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

上記のサンプルコードのなかで、条件文を以下に変更すればOK。

' メール本文に「製品リリース」が含まれるか確認
If InStr(MailItem.Body, "製品リリース") > 0 Then

受信日時で検索する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 特定のメールを特定のフォルダに移動する
  • 特定のメールとは、受信日時が2024年3月1日から2024年4月1日までのメールを指す
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

サンプルコードは以下のとおり。

Sub MoveEmailsToConsumerFolder()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Inbox As Outlook.Folder
    Dim ProductFolder As Outlook.Folder
    Dim ConsumerFolder As Outlook.Folder
    Dim MailItem As Object
    Dim i As Integer
    
    ' 日付の宣言
    Dim StartDate As Date
    Dim EndDate As Date

    ' 日付の設定
    StartDate = DateSerial(2024, 3, 1)
    EndDate = DateSerial(2024, 4, 1)

    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Inbox = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set ProductFolder = Inbox.Folders("製品")
    Set ConsumerFolder = ProductFolder.Folders("コンシューマー")

    ' 受信トレイ内のメールをループ
    For Each MailItem In Inbox.Items
        ' メールがMailItemであることを確認
        If TypeOf MailItem Is Outlook.MailItem Then
            ' 受信日時が指定された範囲内であることを確認
            If MailItem.ReceivedTime >= StartDate And MailItem.ReceivedTime < EndDate Then
                ' メールを「コンシューマー」フォルダに移動
                MailItem.Move ConsumerFolder
            End If
        End If
    Next MailItem

    MsgBox "指定された期間のメールを「コンシューマー」フォルダに移動しました。", vbInformation

    ' オブジェクトの解放
    Set ConsumerFolder = Nothing
    Set ProductFolder = Nothing
    Set Inbox = Nothing
    Set OutlookApp = Nothing
End Sub

フォルダとメール件名で検索する

やりたいこと
  • Outlookで実行するVBAマクロ
  • 特定のメールを特定のフォルダに移動する
  • 特定のメールとは、受信トレイの直下にある「製品」フォルダ内のメールで、件名に「consumer」が含まれるものとする
  • 特定のフォルダとは、受信トレイの直下にある「製品」フォルダの中の「コンシューマー」フォルダとする

サンプルコードは以下のとおり。

Sub MoveSpecificEmails()
    ' Outlookオブジェクトの宣言
    Dim OutlookApp As Outlook.Application
    Dim Namespace As Outlook.Namespace
    Dim Inbox As Outlook.Folder
    Dim ProductFolder As Outlook.Folder
    Dim ConsumerFolder As Outlook.Folder
    Dim MailItem As Object
    
    ' Outlookアプリケーションの初期化
    Set OutlookApp = New Outlook.Application
    Set Namespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = Namespace.GetDefaultFolder(olFolderInbox)
    
    ' 「製品」フォルダの取得
    On Error Resume Next
    Set ProductFolder = Inbox.Folders("製品")
    If ProductFolder Is Nothing Then
        MsgBox "「製品」フォルダが見つかりません。", vbExclamation
        Exit Sub
    End If
    
    ' 「コンシューマー」フォルダの取得
    Set ConsumerFolder = ProductFolder.Folders("コンシューマー")
    If ConsumerFolder Is Nothing Then
        MsgBox "「コンシューマー」フォルダが見つかりません。", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 「製品」フォルダ内のメールをループ
    For Each MailItem In ProductFolder.Items
        ' メールがMailItemであることを確認
        If TypeOf MailItem Is Outlook.MailItem Then
            ' 件名に「consumer」が含まれるかを確認
            If InStr(1, MailItem.Subject, "consumer", vbTextCompare) > 0 Then
                ' メールを「コンシューマー」フォルダに移動
                MailItem.Move ConsumerFolder
            End If
        End If
    Next MailItem

    MsgBox "対象のメールを「コンシューマー」フォルダに移動しました。", vbInformation

    ' オブジェクトの解放
    Set ConsumerFolder = Nothing
    Set ProductFolder = Nothing
    Set Inbox = Nothing
    Set Namespace = Nothing
    Set OutlookApp = Nothing
End Sub

上記のコードを実行すると、「製品」フォルダ内の件名に「consumer」を含むメールが「コンシューマー」フォルダに移動されます。エラーハンドリングも含まれており、指定されたフォルダが存在しない場合にはメッセージが表示されます。

メールを自動送信する方法

以下のコードを実行すると、指定したアドレスにメールが送信されます。

Sub SendEmail()
    ' Outlookアプリケーションを操作するための変数を宣言
    Dim olApp As Outlook.Application
    ' 新しいメールアイテムを操作するための変数を宣言
    Dim olMail As Outlook.MailItem

    ' Outlookアプリケーションのインスタンスを取得
    Set olApp = Outlook.Application
    ' 新しいメールアイテムを作成
    Set olMail = olApp.CreateItem(olMailItem)

    ' 作成したメールアイテムに対してプロパティを設定
    With olMail
        ' 送信先のメールアドレスを設定
        .To = "example@example.com"
        ' メールの件名を設定
        .Subject = "自動送信メール"
        ' メールの本文を設定
        .Body = "これは自動送信されたメールです。"
        ' メールを送信
        .Send
    End With
End Sub

カレンダーイベントを作成する方法

Outlook VBAを使って、カレンダーに自動的にイベントを作成することも可能です。

以下のコードは、指定した日時にカレンダーイベントを作成する例です。

Sub CreateCalendarEvent()
    ' Outlookアプリケーションオブジェクトの変数を宣言
    Dim olApp As Outlook.Application
    ' Outlookの予定表アイテムオブジェクトの変数を宣言
    Dim olApt As Outlook.AppointmentItem

    ' Outlookアプリケーションのインスタンスを取得
    Set olApp = Outlook.Application
    ' 新しい予定表アイテムを作成
    Set olApt = olApp.CreateItem(olAppointmentItem)

    ' 予定表アイテムのプロパティを設定
    With olApt
        ' イベントの件名を設定
        .Subject = "自動作成イベント"
        ' イベントの開始日時を設定(現在の日付の翌日の10:00に設定)
        .Start = Date + 1 + TimeValue("10:00:00")
        ' イベントの継続時間を60分に設定
        .Duration = 60
        ' イベントの本文を設定
        .Body = "これは自動作成されたイベントです。"
        ' イベント開始前に15分前にリマインダーを設定
        .ReminderMinutesBeforeStart = 15
        ' イベントを保存
        .Save
    End With
End Sub
よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!
目次