Outlook/VBA: 受信トレイからフォルダに自動で振り分けるマクロを作った

2017/09/13

このOutlookマクロは、未読メールは受信トレイに置いておき、見終わったら各フォルダに移動、という手順をやっている人に便利です。

受信時に未読状態でフォルダに移動したい人は、Outlookの自動振り分け機能を使った方が良いです。

僕の場合はメールの見逃しを避けるために、未読メールは一旦は受信トレイに集約しておくんですね。で、既読のもののみ各フォルダに移動しています。

ただ、1日50件以上も受信しているので、手作業だと結構時間がかかりすぎるので、マクロを作った次第です。

ある程度、メールが溜まったら（すべて既読状態にして）このマクロを起動すると移動でメールが移動してくれます。かなり便利です。

[ad#top-1]

1 完成形
2 Outlookの準備（設定など）
3 Outlook/VBA
4 振り分けフォルダーの設定

完成形

以下がマクロを起動した際のメール振り分け中の画面です。

カウンターが現れて、あらかじめ設定しておいたフォルダに移動していきます。

ちなみにプログラムはGitHubにて公開中。

satoshi71/OutlookToFolder

Outlookの準備（設定など）

まずは個人フォルダをあらかじめ作っておきます。

会社のメールの状態を公開するわけにもいかないので、個人PCのOutlookを使ってこれから説明します。放置していたらGoogleとMicrosoftから通知がいっぱい来ていました。

これらをフォルダに振り分けるために、個人フォルダを以下のように作りました。右はわかりやすく構成図を示しています。

個人フォルダの作り方はこちらを参考にしてください。

非IT企業に勤める中年サラリーマンのIT日記

Outlookで個人フォルダを作る方法

Outlookで個人フォルダを作る必要があってやったのですが、その方法を忘備録として書いておきます。Outlook2016での例ですが、2010でも同じやり方です。こちらがOutlookの初期画面ですが、ここでメニューの「ファイル」を選択します。下の画面になるので、「アカウント設定」をクリックします。すると、下のようにメニューがプルダウンされるので、その中から「アカウント設定(A)...」をクリックします。下のようなウィンドウが現れるので、「データファイル」タブを開き、タブページ上部の「追加(A)...」をクリックします...

Outlook/VBA

Outlookでマクロ（VBA）を作る場合の基本的なところは以下を参照ください。

非IT企業に勤める中年サラリーマンのIT日記

OutlookでVBAを使ってみる（基本編）

VBAといえば、ほとんどがExcelマクロのことを示しています。たぶん、多くの人はExcel上でしかマクロを組んだことがないんじゃないかと思います。VBAはWordでもPowerPointでもMicrosoft Officeであれば組むことができます。ニーズがExcelに集中しているのでほとんどの情報がExcelマクロになってしまうのですが。Microsoft Officeの１つであるOutlookでもVBAを組むことができます。PowerPointでマクロを組む気にはなりませんが、Outlookの場合はいくつか便利な機能があります。今回は基本的な使い方を紹介します。まずはリボンの設定Outl...

また、メールをフォルダに移動する基本的なソースコードはこちらに書いています。今回はこれを応用します。

非IT企業に勤める中年サラリーマンのIT日記

Outlook/VBA: 受信トレイのメールを個人フォルダに移動する

Outlookにはメール受信時にフォルダへの振り分け機能があるのですが、個人的に受信はあくまで受信トレイに、既読後にフォルダに移動する、という行動を取っています。未読メールは受信トレイに集約したいので。そうなると、自動振り分け機能を使うことができず手動でやるしかありません。そこで、すべて既読にしたあとに、マクロで指定フォルダへ移動するようにしました。個人フォルダの作り方と、Outlookでマクロ(VBA)を使う基本的な手順は以下のブログで書いていますので参考まで。今まで、Outlook2016で説明してきましたが、...

まず最初にUserformでカウンターを作ります。分母の部分がLabel2、分子の部分がLabel1となっています。

ソースコードは以下の通りです。

Function getFolder(psl)
  getFolder = ""
  If InStr(psl, "Google") > 0 Then getFolder = "Google"
  If InStr(psl, "Windows") > 0 Then getFolder = "Microsoft/Windows"
  If InStr(psl, "OneDrive") > 0 Then getFolder = "Microsoft/OneDrive"
  If InStr(psl, "Sway") > 0 Then getFolder = "Microsoft/Sway"
End Function

Sub toFolder()
  Set myapp = CreateObject("Outlook.Application")
  '受信トレイ
  Set i_Folder = myapp.Session.GetDefaultFolder(6)
  '受信トレイの内容を移動
  Dim oDest As Outlook.MAPIFolder 'フォルダー

  UserForm1.Show vbModeless
  UserForm1.Label2 = i_Folder.Items.Count
  UserForm1.Label1 = 0

  '受信トレイを全件処理
  cnt = 1
  For idx = i_Folder.Items.Count To 1 Step -1
    On Error GoTo CONTINUE

    psl = i_Folder.Items(idx).SentOnBehalfOfName
    sbj = i_Folder.Items(idx).Subject

    fld = getFolder(psl)
    If fld <> "" Then
      If InStr(fld, "/") > 0 Then
        f1 = Split(fld, "/")(0)
        f2 = Split(fld, "/")(1)
        Set oDest = Application.Session.Folders("個人用 Outlook データ ファイル").Folders(f1).Folders(f2)
        i_Folder.Items(idx).Move oDest
      Else
        Set oDest = Application.Session.Folders("個人用 Outlook データ ファイル").Folders(fld)
        i_Folder.Items(idx).Move oDest
      End If
    End If

CONTINUE:

    UserForm1.Label1 = cnt
    DoEvents
    cnt = cnt + 1
  Next idx

  Unload UserForm1

End Sub

振り分けフォルダーの設定

メールの振り分けは、getFolder(psl) 関数内で設定します。

If InStr(psl, “送信者名の一部”) > 0 Then getFolder = “フォルダ名”

If InStr(psl, “送信者名の一部”) > 0 Then getFolder = “フォルダ名/サブフォルダ”

のように送信者名に応じて振り分けるフォルダーを指定します。サブフォルダは1階層分だけ指定可能です。親フォルダ-と「/(スラッシュ)」で区切ってください。

以下が例ですが、メール送信者の名前に「Windows」が含まれていたら、Microsoftフォルダの子フォルダWindowsに移動するようになります。

If InStr(psl, “Windows”) > 0 Then getFolder = “Microsoft/Windows”

getFolder(psl) 関数を改めて掲載しておきます。この関数内をカスタマイズさい。

Function getFolder(psl)
  getFolder = ""
  If InStr(psl, "Google") > 0 Then getFolder = "Google"
  If InStr(psl, "Windows") > 0 Then getFolder = "Microsoft/Windows"
  If InStr(psl, "OneDrive") > 0 Then getFolder = "Microsoft/OneDrive"
  If InStr(psl, "Sway") > 0 Then getFolder = "Microsoft/Sway"
End Function

ソースコードはこちら！

satoshi71/OutlookToFolder

[ad#ad-1]

- Outlook, VBA