【Excel】メールを自動作成する

Excelで情報共有しており、Excelに追記した内容をメールで共有するケースがあるかと思います。

面倒なメール作成を自動でできるようにしてみました。
件名やメール本文は微調整してご利用ください。

AutoCreateEmail

1 file(s) 25.16 KB

エクセルファイルをダウンロード

このエクセルファイルの作り方

①マクロを使えるようにする
「マクロを使えるようにする」を参照

②ボタンを配置する
　※ ボタンの配置方法は「表を複数の条件で絞り込む②」を参照

③ボタン配置時の以下の画面で「マクロ名」を「CreateEmail」として「新規作成」を押す

④ 「Microsoft Visual Basic for Applications」にて以下のコードを記載

Sub CreateEmail()
Dim oApp       As Object
Dim objMAIL    As Object
Dim messageList(1) As String
Dim n          As Long
Dim fullName As String
Dim firstName As String

On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
End If

fullName = Application.UserName
firstName = Mid(fullName, 1, InStr(fullName, " ") - 1)

Set objMAIL = oApp.CreateItem(0)
'メールに載せるメッセージ本文'
messageList(0) = "お疲れ様です。" & firstName & "です。" & vbCrLf & vbCrLf & _
"共有ファイルNo." & Cells(3, 3).Value & "に追記を行いました。" & vbCrLf & _
"タイミングを見てご確認ください。" & vbCrLf & vbCrLf & _
"<\ShareServer\メールを自動作成する.xlsm>" & vbCrLf

messageList(1) = vbCrLf & "     以上、宜しくお願い致します。"

Dim adress As String
Dim i As Long
For i = 1 To 50

adress = adress + ThisWorkbook.Worksheets("宛先").Cells(i + 1, 2).Value
adress = adress + " ;"

Next i

objMAIL.To = adress
'件名'
objMAIL.Subject = "共有ファイルNo." & Cells(3, 3).Value & "を追加しました"
objMAIL.BodyFormat = 2 'HTML形式
objMAIL.Body = messageList(0) & messageList(1)
objMAIL.display

n = Len(messageList(0))
ActiveSheet.Range(Cells(Cells(3, 3) + 5, 2), Cells(Cells(3, 3) + 5, 5)).Copy
oApp.ActiveInspector.WordEditor.Range(n, n).Paste
Application.CutCopyMode = False

Set objMAIL = Nothing
Set oApp = Nothing
End Sub