Excelにメール送信ボタン設置で連絡ミス防止！

Aさん

Excelに依頼入力事項を記入した後、担当者への連絡を忘れて困ってるんだ！

わたし

なんで皆連絡を忘れてしまうの？

Aさん

多分だけどメールを送るのが面倒くさいんだと思う、どうすればいいかな？

わたし

それならマクロを使ってボタン1つで定型メールを送れるようにしたらどう？

今回の業務内容について
1. 対策内容
2. Excel実物全体画像

今回の業務内容について

・今回は会社で使用している補修依頼用Excelフォーマットに入力した後、設備担当者への連絡を忘れてしまうことが頻発した為、その対策として簡単なマクロ組んで対策を行いました。

対策内容

・ボタン押すだけでOutlookから定型文メールを送信出来るようにする。

Excel実物全体画像

上記のような感じで作成しています。左側(不具合入力シート)には補修依頼するITEMの情報を記入します。右側の表(メール設定表)にはOutlookでメールを送る内容、宛先、ハイパーリンクなどを設定することが出来ます。

不具合入力シート

こちらについては皆さんの都合に合った表を作成して頂ければ問題ありません。

・表作成のポイント

1.決まったことを入力する列にはデータの入力規則を使う。

　①設定したいセルを選択した状態で「データ」タブのデータツール内にある『データの入力規則』をクリックする

②設定タブの「入力値の種類」を選択し、元の値欄に入力して欲しい値を記入します。文字と文字の間には『,』カンマを入力してください。下記の様に入力したらOKを押します

③選択していたセルにプルダウンが表示されるようになっていることを確認する。

2.データの入力規則で入力された値を参照することで、別の列に値が表示されるようにする。

　例.配管スペックをプルダウンで選択したら、配管の設計圧力・設計温度が入力される。

①下記図の場合、配管クラスを『データの入力規則』で入力するように設定する

※データの入力規則で沢山のリストを表示させたいときは、別に配管クラスに対する設計温度・設計温度の表を作成しましょう。下記図の参照。

上記で作成した表をデータの入力規則で下記の様に選択することで手入力せずともプルダウンに表示させることが出来ます。※下図の例では、シート名『パイピングスペック』のB列に上記図の配管クラス列が記入されている為、選択肢として表示させたいセル全部を選択しています。

以上のように設定することで、１か所入力するだけで複数個所の定型データを一括で自動入力させることが出来ます。

メール設定表

上記のリストにメールの宛先(TO,CC,BCC)、件名、本文、署名(本文の最後に記入される)、ハイパーリンク(本文中に記入されます)を記入します。

マクロ

Sub sendmail()


    Dim alert As VbMsgBoxResult
    alert = MsgBox("4MDBを入力して赤札・青札を付けましたか？ 本当に設備担当にメール送信してよろしいですか？", vbYesNo + vbQuestion, "実行確認")
    If alert = vbYes Then
　　'メール送信ボタンを押したときにメッセージBOXが出し、YESを選択したときのみ以下のコードを実行する
    
    Dim ws As Worksheet
    Set ws = Worksheets("バルブ取替")　'メール設定表があるシート名を記載する

    Dim outlookObj As Outlook.Application
    Set outlookObj = CreateObject("Outlook.Application")
　　'Outlookを起動する
    
    Dim mymail As Outlook.MailItem
    Set mymail = outlookObj.CreateItem(olMailItem)
    
    mymail.BodyFormat = 2
    mymail.To = ws.Range("AK4").Value　'宛先を記入したセル名
    mymail.CC = ws.Range("AK5").Value　'CCを記入したセル名
    mymail.BCC = ws.Range("AK6").Value　'BCCを記入したセル名
    mymail.Subject = ws.Range("AK7").Value　'件名を記入したセル名
    'mymail.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name '添付資料を付けるときに活かす
    
   Dim honbun As String, credit As String, mailbody As String, strstyle As String
   honbun = Replace(ws.Range("AK8").Value, vbLf, "<br>") '本文を記入したセル名
   credit = Replace(ws.Range("AK9").Value, vbLf, "<br>")　'署名を記入したセル名
   strstyle = "<font face=""ＭＳ Ｐ明朝"">" & honbun & "</font>"
   mailbody = strstyle & "<br>" & "<br>" & credit & "<br>"
   Debug.Print "mailbody:" & mailbody
    
    Dim links(4) As String
    links(0) = ws.Range("AK12").Value　'ハイパーリンク1を記入したセル名
    links(1) = ws.Range("AK13").Value　'ハイパーリンク2を記入したセル名
    links(2) = ws.Range("AK14").Value　'ハイパーリンク3を記入したセル名
    links(3) = ws.Range("AK15").Value　'ハイパーリンク4を記入したセル名
    links(4) = ws.Range("AK16").Value　'ハイパーリンク5を記入したセル名
    
    Dim urls(4) As String
    Dim i As Long
    For i = LBound(links) To UBound(links)
        urls(i) = "<a href=""" & links(i) & """>" & links(i) & "</a>"
        Debug.Print "i:" & i, urls(i)
        mailbody = Replace(mailbody, "URL" & i + 1, urls(i))
        Next
        
    mymail.HTMLBody = mailbody
    
    'Dim attachedfile As String 'プラスで添付資料を付けたいときに活かす
    'attachedfile = ThisWorkbook.Path & "\" & ws.Range("AJ11").Value
    'If Not attachedfile = "" Then
        'mymail.Attachments.Add Source:=attachedfile
    'End If
    
    
    mymail.Display
    
    mymail.Save
    
    mymail.Send
    
    Set outlookObj = Nothing
    Set mymail = Nothing
    
    End If
End Sub