エクセルVBA テーブル行が変化したら上司へ自動メール連絡

<h2><br><br>プログラムを組んだ目的</h2>



<p><br><br>エクセルのテーブル機能を使ってデータやリストの管理を行っており、データが追加されたら上司に連絡する必要がある時ありませんか？</p>



<p>毎回、同じ内容を伝えるのも面倒と言うことでメールで伝えることができるようにしてみました。</p>



<p>これなら、宛先とメール本文を固定しておけば、テーブルに変化が起きた時に自動で上司へ報告することができます。</p>



<p>報告忘れ防止にもなります。</p>



<h2><br><br>必要になるソフトウェア<br><br></h2>



<ul><li>エクセル</li><li>アウトルック</li></ul>



<h2><br><br>プログラムの組み方<br><br></h2>



<h3>特定のシートからテーブルのオブジェクトと最終行を取得するプログラム</h3>



<p><br>「<strong>Alt + F11</strong>」でVBAを開く。</p>



<p>「<strong>thiswookbook</strong>」をダブルクリックで開きそこにプログラムを記述していく。</p>



<div class="hcb_wrap"><pre class="prism undefined-numbers lang-c" data-lang="C"><code>&#39;変数の定義
Dim lst1 As ListObject
Dim cntBf As Long
Dim cntAf As Long


Private Sub Workbook_boforeclose(wb As Boolean)

&#39;  顧客リストシートからテーブルの行を取得する
  cntBf = Sheets(&quot;顧客リスト&quot;).Range(&quot;b1&quot;)
  Set lst1 = Sheets(&quot;顧客リスト&quot;).ListObjects(1)
  cntAf = lst1.ListRows.Count

&#39;  顧客リストシートのテーブル行を比較し、変化があればメール送信プログラムを動かす
  If cntBf &lt;&gt; cntAf Then
    Call 自動メール送信  &#39;メール送信用プログラムを呼び出す（下に記載）
    MsgBox(&quot;メールを送信しました&quot;)
  End If

End Sub



Private Sub workbook_open()

&#39;  顧客リストシートからテーブルの最終行を取得
  Set lst1 = Sheets(&quot;顧客リスト&quot;).ListObjects(1)
  cntBf = lst1.ListRows.Count
  Sheets(&quot;顧客リスト&quot;).Range(&quot;b1&quot;).Value = cntBf

End Sub</code></pre></div>



<h3><br><br>メール送信プログラム（標準モジュールを追加）</h3>



<p><br>まず、エクセルファイルに「<strong>メール送信先シート</strong>」を作成する。<br></p>



<p>VBAに移動し、</p>



<p>１、メニューバーの「<strong>ツール</strong>」から「<strong>参照設定</strong>」を選択。</p>



<p>２、その中から「<strong>Microsoft Outlook 16.0 Object Library</strong>」を探してチェックを入れる。</p>


<p>３、メニューバーの「<strong>挿入</strong>」から「<strong>標準モジュール</strong>」を選択し、プログラムを記述していく。</p>



<div class="hcb_wrap"><pre class="prism undefined-numbers lang-c" data-lang="C"><code>Sub 自動メール送信()

  &#39;変数の定義とオブジェクト作成(outlook起動)
  Dim toaddress As String
  Dim subject, mailBoby As String
  Dim outlookObj As Outlook.Application
  Dim mailItemObj As Outlook.MailItem

  &#39;変数へデータ格納（メール送信先シートへ書いておく必要がある）
  toaddress = Sheets(&quot;メール送信先シート&quot;).Range(&quot;b2&quot;) &#39;宛先
  subject = Sheets(&quot;メール送信先シート&quot;).Range(&quot;b3&quot;)　&#39;件名
  mailBody = Sheets(&quot;メール送信先シート&quot;).Range(&quot;b4&quot;)　&#39;本文

  &#39;新規メール作成
  Set outlookObj = CreateObject(&quot;Outlook.Application&quot;)
  Set mailItemObj = OutlookObj.CreateItem(olMailItem)
  mailItemObj.BodyFormat = 2
  mailItemObj.To = toaddress
  mailItemObj.subject = subject

  &#39;本文へハイパーリンクをつける
  Dim link1, strstyle, url As String
  link1 = Sheets(&quot;メール送信先シート&quot;).Range(&quot;b5&quot;)
  url = &quot;&lt;a href=&quot;&quot;&quot; & link1 & &quot;&quot;&quot;&gt;&quot; & &quot;リンクを付けたいファイルの名前&quot; & &quot;&lt;/a&gt;&quot;
  strstyle = &quot;&lt;font face=&quot;&quot; MS P明朝 &quot;&quot; color = &quot;&quot; #fff &quot;&quot;&gt;&lt;b&gt;&quot; & mailBody & &quot;&lt;/b&gt;&lt;/font&gt;&lt;br&gt;&quot; & url
  mailItemObj.HTMLBody = strstyle

  &#39;メール送信
  mailItemObj.display
  &#39;mailItemObj.send 　※コメント化を解けばメール送信される

  &#39;オブジェクト開放
  Set outlookObj = Nothing
  Set mailItemObj = Nothing

End Sub</code></pre></div>



<h2><br><br>このプログラムを使うための注意点<br><br></h2>



<ol><li>テーブルは「３行目以下」に作成しておく</li><li>メール送信先シートの「b2セル〜b5セル」に「宛先」、「件名」、「本文」を記載する<br><br></li></ol>



<h2>プログラムの説明<br><br></h2>



<ol><li>エクセルファイルが開いた時に「顧客リストシート」のテーブルの最終行を取得し、「b1セル」に数値を貼り付ける。</li><li>ファイルを閉じる動作をした時に「顧客リストシート」の「b1セル」の数値とテーブルの最終行を比較し、違っていればメールの送信プログラムを動かす。</li><li>「メールの送信先シート」から「宛先、件名、本文」を読み取りメール作成からメール送信までを自動で実施する。</li></ol>