Outlookマクロでミスを防ぐ！業務効率化への第一歩（後編）
こんにちは、春っちです🌸
今回は「Outlookマクロでミスを防ぐ！業務効率化への第一歩」の後編をお届けします。
前回お話しした“発注ミス防止の仕組みづくり”を、実際に形にしてみました。
発注ミスを防ぐためのマクロ
今回作ったマクロはとってもシンプルです。
「開始日と終了日を入力すると、Excelが自動で開き、送信済みメールのデータが出力される！」という仕組み。
手順はこんな感じです▼
-
期間を指定する（送信日で絞り込みたい場合に便利）
-
送信済みメールの中から「【発注」で始まるメールを抽出
-
Excelに以下の情報を出力
・発注者（送信者）
・金額
・発注先
・件名
・送信日
以上！
とてもシンプルですが、送信ミスや抜け漏れを一覧でチェックできるので、作業効率がすごくアップしました。
今はAIも便利！
今は、AIのおかげで「やりたいこと」を順番に書くだけで、その通りにコードを作ってくれる時代になりました。
もし思い通りに動かなくても、「こう動かせたらもっと便利なのに！と感じたことをそのまま言語化できる力が大切なのかなと思います。
単調なルーチン作業も、AIを上手に活用しながら、ワクワクしながら取り組んでいけたらいいな…🌸
Outlookマクロは意外と簡単！
実際に使ったことがある人は少ないかもしれませんが、操作はほぼExcelのマクロと同じです。
手順はこんな感じです▼
-
VBAエディタを開く
Outlookで「Alt + F11」を押す -
新しいモジュールを作成
左側の「ThisOutlookSession」を右クリック → 挿入 → モジュール -
マクロコードを貼り付ける
コピーしたマクロをそのままペースト -
マクロを実行！
VBAエディタでマクロ内にカーソルを置き、「F5キー」を押すだけ
これでOK🙆♀️
ExcelやOutlookの設定変更もほとんど不要で、最小限の操作で動かせます。
マクロを使う前の前提条件
使う前に、確認しておきたいポイントもあります。
-
決まったフォーマットのメールで送信していること（本文中の「【金額】」「【件名】」などのラベルが固定であること）
- Outlookを使用していること（他のメールソフトやWebメールでは動作しないので注意です⚠️）
おわりに
前回と今回で「Outlookマクロで発注ミスを防ぐ仕組み」をご紹介しました。
AIや自動化ツールが進化しても、最後の確認や工夫は人の手にしかできないことがたくさんあります。
便利さを味方にしながら、自分らしい“ちょっとした仕組みづくり”を積み重ねていけたらいいなと思います🌼
次回は、実際に業務に組み込むときの便利なアレンジなどもご紹介できたらと思っています。
具体的なコードはこちら▼
※実際に使うときは、みなさんの業務環境に合わせてAIに修正をお願いするのが安心です。
Sub ExportOrderEmails_Short()
' Outlook送信済みメールから「【発注」で始まるメールを抽出し、
' Excelに発注者（送信者名）、金額、発注先、件名、送信日を出力するマクロ
Dim olNs As NameSpace, f As Folder, m As MailItem
Dim xl As Object, ws As Object, wb As Object
Dim d1 As Date, d2 As Date, r As Long
Dim b As String, firstLine As String
On Error GoTo Err
' --- 抽出対象期間を入力 ---
d1 = CDate(InputBox("開始日を入力（例：8/15）"))
d2 = CDate(InputBox("終了日を入力（例：8/18）")) + 1 - TimeSerial(0,0, 1)
If d2 < d1 Then MsgBox "終了日は開始日以降にしてください。": Exit Sub
' --- Excel起動・新規ブック作成 ---
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.Workbooks.Add
Set ws = wb.Sheets(1)
' --- 見出し行 ---
ws.Range("A1:E1").Value = Array("発注者", "金額", "発注先", "件名", "送信日")
r = 2
' --- Outlook送信済みフォルダ ---
Set olNs = Application.GetNamespace("MAPI")
Set f = olNs.GetDefaultFolder(olFolderSentMail)
' --- メール確認ループ ---
For Each m In f.items
If TypeName(m) = "MailItem" Then
' 指定期間 & 件名が「【発注」で始まるメール
If m.SentOn >= d1 And m.SentOn <= d2 And m.Subject Like "【発注*" Then
' 本文取得（空ならHTMLをテキスト化）
b = m.body
If Len(Trim(b)) = 0 Then b = StripHTML(m.HTMLBody)
' 本文1行目（発注先の簡易表示）
firstLine = Split(b, vbCrLf)(0)
' --- Excel出力 ---
With ws
.Cells(r, 1).Value = m.SenderName ' 発注者（送信者名を自動取得）
.Cells(r, 2).Value = GetVal(b, "【金額】") ' 金額
.Cells(r, 3).Value = firstLine ' 発注先（本文1行目）
.Cells(r, 4).Value = GetVal(b, "【件名】") ' 件名
.Cells(r, 5).Value = m.SentOn ' 送信日
End With
r = r + 1
End If
End If
Next
' --- 並べ替え（発注者 → 金額） ---
ws.Range("A2:E" & r - 1).Sort _
Key1:=ws.Range("A2"), Order1:=1, _
Key2:=ws.Range("B2"), Order2:=1, Header:=0
ws.Columns("A:E").AutoFit
MsgBox "完了しました。"
Exit Sub
Err:
MsgBox "正しい日付を入力してください。"
End Sub
' --- 本文中の指定キーに対応する値を取得（1回だけ定義） ---
Function GetVal(body As String, key As String) As String
Dim line As Variant
For Each line In Split(body, vbCrLf)
' 半角・全角スペースを無視してキーを検索
If InStr(Replace(Replace(line, " ", ""), " ", ""),
Replace(Replace(key, " ", ""), " ", "")) > 0 Then
' キー文字列の後ろ部分を取得して返す
GetVal = Trim(Mid(line, InStr(line, key) + Len(key)))
Exit Function
End If
Next
' 見つからなかった場合は空文字を返す
GetVal = ""
End Function
' --- HTML本文からタグを除去してテキスト化する ---
Function StripHTML(html As String) As String
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "<[^>]*>" ' HTMLタグをすべて除去
StripHTML = .Replace(html, "")
End With
End Function
最後までご覧いただきありがとうございました★☆★