Outlookのグループメンバを使用することで生じる弊害
Outlookで定期的に関係者(グループメンバ)へメール送信している場合、グループメンバの異動があるとメールアドレスの修正漏れにより正確に送信できないことがあります。それは、Outlookの連絡先グループの修正ミスや修正漏れにより発生します。特に複数の連絡先グループに関係している人が異動した場合がそうです。メールを送信してから異動した旨の返信をもらいはじめてそれに気が付き、グループのメンバ修正を行い、後任者へそのメールを送信します。
業務で定期的にメール送信している方は、いっそのことOutlookでの連絡先グループの管理をやめてExcelで管理した方が効率的です。Excelで管理すれば誰にどの案件のメールを送信しなければならないのか一覧表示で管理できる上に、案件毎の本文もまとめて管理できるので楽です。さらにマクロを使用してメールも送信することができるのです。
それでは、Excelで管理する方法を説明します。縦方向にメールアドレス、横方向に案件の表を一つのシートに作成します。案件列へは、宛先となる人は、’*’文字をCcとなる人は、’+’文字を設定します。Bccが必要であれば’-‘文字を設定します。異動によりメール送信が不要となったメンバの行を削除し、新たにメンバが増えた場合は、対象者の行を追加または挿入します。一時的に送信が不要となったメンバの行を非表示にすれば行を削除しなくても送信対象から外すことができます。
次にメール本文ですが、案件名のシートを作成し本文を記載します。メールの書式は、プレーンテキストとHTMLのどちらかを設定することができます。またファイルを添付することも可能で、ファイルの場所をフルパスで添付ファイルセルの下へ設定します。添付ファイルは行を挿入することで複数設定することができます。その際の注意として、本文セルの上のセルは空欄にしてください。本文は、本文セルの下から設定します。その際の注意として、文字の色、背景色、ハイパーリンク設定を行う場合は、それらを別のセルにします。

ダウンロード
VBAマクロの説明
例.月報提出依頼メールのフロー
-
Outlookのメールオブジェクトを作成します。
-
メールオブジェクトへ宛先とCcを設定します。
-
メールオブジェクトへ件名を設定します。
-
メールフォーマット(PLAINかHTML)を設定します。
-
案件に対応するタブからメール本文へコピペします。
-
メールフォーマットがHTMLの場合、表形式から”~”区切りへ変換します。
-
”~”区切りを削除します。
Sub 月報提出依頼メール()
1 |
Call makeMail("月報提出", "HTML", "月報提出依頼") |
引数1:案件名(「月報提出」)
引数2:メールのフォーマット(「HTML」)
引数3:メールの件名(「月報提出依頼」)
共通関数 makeMail(案件名、メールのフォーマット、メールの件名)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Private Function makeMail(item As String, form As String, title As String) Dim outlookObj As Object Dim mailItemObj As Object Set outlookObj = CreateObject("Outlook.Application") Set mailItemObj = outlookObj.CreateItem(olMailItem) Dim clm As Long Dim i As Long, j As Long Dim buf As String With Worksheets("MailAddress") For clm = 4 To .Cells(1, Columns.Count).End(xlToLeft).Column If .Cells(1, clm) = item Then Exit For Next End With With mailItemObj .To = getAddress(clm, "To") .CC = getAddress(clm, "Cc") Dim dtLm As String .Subject = title If form = "HTML" Then .BodyFormat = olFormatHTML Else .BodyFormat = olFormatPlain End If i = 2 Do While Worksheets(item).Cells(i, 1) <> "" .Attachments.Add Trim(Worksheets(item).Cells(i, 1)) 'Trimは、必須 i = i + 1 Loop .Display End With ' Outlookへ文字を送る Dim rowSt As Long, rowEd As Long, clmEd As Long Dim objdoc As Variant With Worksheets(item) rowSt = .Range("A:A").Find(What:="本文").Offset(1).Row rowEd = .Range("A" & Rows.Count).End(xlUp).Row Set objdoc = outlookObj.ActiveInspector.WordEditor For i = rowSt To rowEd clmEd = .Cells(i, Columns.Count).End(xlToLeft).Column If form = "HTML" Then .Range(.Cells(i, 1), .Cells(i, clmEd)).Copy 'セルの内容をクリップボードへコピー objdoc.Characters.last.Paste Else For j = 1 To clmEd buf = .Cells(i, j) 'セルの内容を取り出す If buf <> "" Then objdoc.Application.Selection.TypeText buf End If Next objdoc.Application.Selection.TypeText vbCrLf End If Next End With Application.CutCopyMode = True 'Excel表形式から通常のフォームへ変換する If form = "HTML" Then BatchConvertAllTablesToText Call SetBackgroundColor(Worksheets(item)) End If End Function |
列番号と宛先種別を引数に共通関数 getToAddress をコールすることで、メールの宛先とCcを受け取ります。受け取ったアドレスをメールオブジェクトへ設定します。
続けてメールのフォーマットとメールの件名をメールオブジェクトへ設定します。
案件名に対応するシートの添付ファイルのファイルパスをメールオブジェクトへ設定します。
案件名に対応するシートの本文をワードエディタオブジェクトへ設定します。
共通サブルーチン BatchConvertAllTablesToText をコールし通常のフォームへ変換します。
共通サブルーチン ReplaceNewLineTag をコールしタグを削除します。
共通関数 getAddress(列番号、宛先種別)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
Private Function getAddress(clm As Long, tocc As String) As String Dim i As Long Dim i_Row As Long Dim toAddr As String Dim schar As String If tocc = "To" Then schar = "*" Else schar = "+" End If With Worksheets("MailAddress") i_Row = .Range("C1").CurrentRegion.Rows.Count For i = 2 To i_Row If .Cells(i, clm) = schar And .Cells(i, clm).EntireRow.Hidden = False Then toAddr = toAddr & ";" & .Cells(i, 3) End If Next End With getAddress = toAddr End Function |
共通サブルーチン BatchConvertAllTablesToText()
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
Private Sub BatchConvertAllTablesToText() Dim objMail As Outlook.MailItem Dim objMailDocument As Word.Document Dim objTables As Word.Tables Dim objTable As Word.Table 'Get the currently opened email Set objMail = Outlook.Application.ActiveInspector.CurrentItem Set objMailDocument = objMail.GetInspector.WordEditor 'Get all the tables of the current email Set objTables = objMailDocument.Tables 'Convert all tables to text For Each objTable In objTables objTable.ConvertToText Separator:="~" Next 'Delete separator With objMailDocument.Content.Find .ClearFormatting '検索条件から書式を削除 .Text = "~" 'Separator .Replacement.ClearFormatting .Replacement.Text = "" 'Delete .Forward = True '下方向に検索 .Wrap = wdFindContinue '文書の末尾に到達した場合、検索を文書の先頭から続行 .Format = False '書式の置き換えをしない .MatchCase = True '大文字と小文字を区別 .MatchWholeWord = False '完全に一致する単語 .Execute Replace:=wdReplaceAll '置換文字列を全て End With End Sub |
次に区切り文字”~”を削除します。
共通サブルーチン SetBackgroundColor(sh As Worksheet)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Private Sub SetBackgroundColor(sh As Worksheet) Dim listNo As Long, clmEd As Long Dim i As Long, j As Long, clindex As Long Dim moji As String With sh listNo = .Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To listNo clmEd = sh.Cells(i, Columns.Count).End(xlToLeft).Column For j = 1 To clmEd If .Cells(i, j).Interior.ColorIndex <> xlNone Then moji = .Cells(i, j).Text clindex = .Cells(i, j).Interior.ColorIndex Call SetTextBackColor(moji, clindex) End If Next Next i End With End Sub |
文字列とカラーインデックスを引数に共通関数 SetTextBackColor をコールして、メール本文の文字列の背景色を設定します。
共通関数 SetTextBackColor(ByVal moji As String, ByVal clindex As Long)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
Private Sub SetTextBackColor(ByVal moji As String, ByVal clindex As Long) Dim cclr As Long Dim colorTable As Variant colorTable = Array(wdBlack, wdWhite, wdRed, wdBrightGreen, wdBlue, wdYellow, wdPink, wdTurquoise, wdDarkRed, wdGreen, wdDarkBlue, wdDarkYellow, wdViolet, wdTeal, wdGray25, wdGray50) If UBound(colorTable) < clindex - 1 Then Exit Sub cclr = colorTable(clindex - 1) Dim outlookObj As Object Dim objdoc As Variant Set outlookObj = CreateObject("Outlook.Application") Set objdoc = outlookObj.ActiveInspector.WordEditor Application.ScreenUpdating = False With objdoc .Application.Options.DefaultHighlightColorIndex = cclr With .Content.Find .ClearFormatting .Text = moji With .Replacement .Text = "" .ClearFormatting .Highlight = True End With .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = False .Execute Replace:=wdReplaceAll End With End With Application.ScreenUpdating = True End Sub |
注)メール本文中に指定された文字列が複数存在する場合、それら全の背景色が設定されます。 背景色に指定できるのは、基本16色です。
まとめ
- 定期的にグループへ送信するメールのアドレスを、Outlookのグループでアドレス管理していると異動があった場合に、修正漏れとなりがちです。
- Excelでグループアドレス管理すれば修正漏れが発生しにくくなります。
- Excelのマクロを使用することでグループへメール送信することができます。
コメントを残す