メールボックスを分析しよう！【第12週】プログラミング未経験者が独学成果物で「1千イイね」とれるまでリアルタイム実況
■メールが多すぎる！！
という声が、現場から聞こえてきました。
弊社でも昨今の例に漏れず、TeamsやZoomといったツールを活用しておりますが、まだまだOutlookに頼る部分が多いのが現状です。
各部署・セクションからの連絡や指示だけでなく、最近はコロナ関係や私のチームがRPAで自動配信している情報など、毎日非常に多くのメールが飛び交っています。
■”何が”、”どれくらい” 多いのか
「メールが多い」とは、なかなかに曖昧な意見ですよね。
・以前に比べて○○件の受信数が増えた。
・○○部の連絡が他と比較して多い。
・CCでの受信が多い。（当事者ではない）
など、いろいろな可能性があります。
まずは、きちんと実態調査をしなくてはいけませんね。
■Outlookのメール情報を抜き出そう！
参考にさせて頂いたのはこちらの記事。
多少手を加えたもの以下の通りです。
①まずはマクロファイルと内容を転記するシートを用意
②以下のマクロを記述
Sub Outlook_mail_list()
'''---1｜このコード内で使用する変数を宣言
'変数設定: 受信トレイ､解析するメールの番号､エクセルの行数､
'添付ファイルの数､添付ファイルの数
Dim InboxFolder, i, n, k, attno As Long
'変数設定: 受信トレイ内の総メール件数メッセージ､添付ファイルの保管先
Dim sender, mes, path1 As String
'Outlookで使用するオブジェクト生成
Dim outlookObj As Outlook.Application
'Outlookで使用するオブジェクト(2つ)生成
Dim myNameSpace, objmailItem As Object
'フォルダ生成で使用するオブジェクト
Dim fso As New Scripting.FileSystemObject
'''---2｜定義した変数に必要な項目をセット
'受信メールを解析するシート名を「受信メール一覧」で設定
Set outlookObj = CreateObject("Outlook.Application")
'Outlookのメールを解析のおまじない
Set myNameSpace = outlookObj.GetNamespace("MAPI")
'(6)とすることで、受信トレイを指す。
Set InboxFolder = myNameSpace.GetDefaultFolder(6)
'取扱いやすいように、受信トレイ内に「サブ」というフォルダを事前に用意。これを指定する。
Set subFolder = InboxFolder.Folders("サブ")
'受信メールの解析結果を出力する最初の行数を指定(ここではエクセルの2行目から使用)
n = 2
'''---3｜メールの添付ファイルを保管するフォルダを作成
'添付ファイルを保管するフォルダの名称を決める
mes = InputBox("メール添付資料の保管用フォルダを新しく作成します｡フォルダ名を入力してください")
'添付ファイルを保管するフォルダは､使用しているエクセルファイルと同じフォルダに生成
path1 = "C:\Users\****\Documents\メール分析" & "\" & mes
'添付ファイルを保管するフォルダを生成
fso.CreateFolder (path1)
'''---4｜解析する受信メールの範囲を決める
'現在､受信トレイに保管されているメールが何通あるかメッセージを出す
MsgBox subFolder.Items.Count
'i=(1,2,3,・・・,受信トレイ内の総メール件数)を順次セット。
'受信トレイの(1通目、2通目、…、受信トレイ内の最後のメール)までを繰り返し解析
For i = 1 To subFolder.Items.Count
'objmailItemに受信トレイのi通目のメールをセット
Set objmailItem = subFolder.Items(i)
'''---5｜受信メールの各情報を取得
'セルAn(nは1,2,3,…)に、何通目のメールを解析しているかカウントする。(iをそのまま転用)
Range("A" & n).Value = i
'セルBn(nは1,2,3,…)に、解析したメールの受信日時を出力
Range("B" & n).Value = objmailItem.ReceivedTime
'セルCn(nは1,2,3,…)に、解析したメールの件名(タイトル)を出力
Range("C" & n).Value = objmailItem.Subject
'セルDn(nは1,2,3,…)に、解析したメールの送信者名を出力
Range("D" & n).Value = objmailItem.SenderName
'セルEn(nは1,2,3,…)に、解析したメールのToを出力
Range("E" & n).Value = objmailItem.To
'セルEn(nは1,2,3,…)に、解析したメールのCCを出力
Range("F" & n).Value = objmailItem.CC
'セルFn(nは1,2,3,…)に、解析したメールの内容(本文)を出力。先頭200文字だけを切り出す設定にしている。
Range("G" & n).Value = Left(objmailItem.Body, 200)
'''---6｜メールの添付ファイルを保管する
'attno = 解析しているメールの添付ファイル数
attno = objmailItem.Attachments.Count
'もし、解析しているメールに添付ファイル数が0より大きいならば(1つ以上あるなら)
If attno > 0 Then
'for next文で一つずつ、添付ファイルをフォルダへ保管する
For k = 1 To attno
objmailItem.Attachments(k).SaveAsFile (path1 & "\" & objmailItem.Attachments(k).DisplayName)
Next
'セルGn(nは1,2,3,…)に、解析したメールに含まれる添付ファイル数(k)を出力。
Range("H" & n).Value = k - 1
'もし､解析しているメールに添付ファイル数がないなら
Else
'セルGn(nは1,2,3,…)に、「なし」と出力。
Range("H" & n).Value = "なし"
End If
'出力するエクセルの行数を+1する
n = n + 1
Next
'''---7｜セットした変数を解除
Set outlookObj = Nothing
Set myNameSpace = Nothing
Set InboxFolder = Nothing
End Sub③Outlookの受信フォルダ内に「サブ」フォルダを作成
※２のコードと注釈を参照
④サブフォルダに分析したいメールを全て移動
⑤マクロを起動
参考にしたコードのままでは、Microsoft Exchange アカウントの情報を（特にアドレス）を正しく取得できないようだったので、そこを改良。
※Microsoft Exchange アカウントは、職場または学校のメール アカウントです。 Exchange メール アカウントを提供した組織は、 Microsoft Exchange Serverを実行している、またはメールを Microsoft 365 を使用 Exchange Server を使用しています。
■そして分析…
取得した情報で分析を進めています。
・COUNTIFでTo・CC・(Bcc)の件数算出
・送信者から送信部署等を特定
・タイトルと内容から目的等を推定し、属性を付ける（手動）
※属性は以後使いまわせるので、最初は頑張ろう
これらを表やグラフに起こすと。
声を出された方々には、結果を開示して、想定内なのか想定外なのかを踏まえて改善案を考えてもらおうかと思います。