ゆるおたノート

Tomorrow is another day.

【Excel VBA】定型メールをボタン1つで作成する手段を考える話。

毎日、仕事でメールを書いています。

顧客情報(Webページ)をコピペして、その説明を書いて、何回かチェックして送信、…
という流れなのですが、頭の回転が遅いのとケアレスミスでやり直すのとで結構時間を食います。そして無駄にイライラする…

そうこうしているうちにお客様もお待たせしてしまうし、誤開示なんてことになったら…
と考えると良いことがありません。

そもそもコピペ部分はシステムでどうにかして欲しいのですが笑、なかなかそうもいかず。
少しでも頭を使う時間を確保するためにExcelの力を借りてみました。

シートの作成イメージ

AAA不動産から、BBBカンパニーに何やら不穏な会合のお知らせをお届け、という設定(仮)。

※画像はイメージです。 f:id:yuricks7:20181111180953p:plain

まず、定型的な項目に絞って入力項目を考えます(A列)。
B列にその内容を記入すると、D列のExcel関数でメール本文が作成されます。

作成後、D1セルにあるこれを格納ボタンを押すとD列の文章が
クリップボードに格納されるので、それを貼り付けて送信、という寸法です。

コード

D1セルのボタンに設定するコードは以下の通りです。

Option Explicit

'=======================
'【1】格納するセルの範囲を設定
'=======================
Public Sub setVariableForInfoMail()

    Const FIRST_ROW As Long = 2
    Const LAST_ROW As Long = 23

    Dim TARGET_COL As Long = 4

    Call storeIntoClipboard(FIRST_ROW, LAST_ROW, TARGET_COL)

End Sub

'F列で内容の違うメールを作成して、F1セルにもボタンを作る
Public Sub setVariableForAskMail()

    Const FIRST_ROW As Long = 2
    Const LAST_ROW As Long = 7

    Dim TARGET_COL As Long = 6

    Call storeIntoClipboard(FIRST_ROW, LAST_ROW, TARGET_COL)

End Sub

'=======================
'【2】連結した文字列をクリップボードに格納する(メイン)
'=======================
'事前にライブラリの参照設定をしておく。
'ユーザーフォームの 追加 > 削除 でok。
'ライブラリ名:【Microsoft Forms 2.0 Object Library】
Private Sub storeIntoClipboard(ByVal firstRow As Long, _
                               ByVal lastRow As Long, _
                               ByVal targetCol As Long)

    Dim ThisSheet As Worksheet
    Set ThisSheet = ThisWorkbook.ActiveSheet

    Dim tmpStrings As String
    tmpStrings = joinStrings(ThisSheet, firstRow, lastRow, targetCol)

    With New MSForms.DataObject
        .SetText tmpStrings<br>'変数の値をDataObjectに格納する
        .PutInClipboard<br>'DataObjectのデータをクリップボードに格納する
    End With
    
    '参考としてH列に連結結果を出力
    Const OUTPUT_COL As Long = 8
    ThisSheet.Paste Destination:=ThisSheet.Cells(firstRow, OUTPUT_COL)
    
    MsgBox "格納しました。" & vbCrLf & _
                "一旦メモ帳に貼り付けてお使いください。"

End Sub

'=======================
'【3】文字列を連結する
'=======================
Private Function joinStrings(ByRef targetSheet As Worksheet, _
                             ByVal firstRow As Long, _
                             ByVal lastRow As Long, _
                             ByVal targetCol As Long) As String

    Dim results As String: results = targetSheet.Cells(firstRow, targetCol)
    
    Dim i As Long
    For i = firstRow + 1 To lastRow
        results = results & vbCrLf & targetSheet.Cells(i, targetCol)
    Next i

    joinStrings = results

End Function

ちょっとだけ補足します

【1】格納するセルの範囲を設定

ワークシートの列ごとに何パターンか定型文を用意するとして、
ボタンごとに格納する範囲を設定します。

Public Sub setVariableForInfoMail()

    Const FIRST_ROW As Long = 2
    Const LAST_ROW As Long = 23

    Dim TARGET_COL As Long = 4

    Call storeIntoClipboard(FIRST_ROW, LAST_ROW, TARGET_COL)

End Sub

※多分これは最終行の取得(苦手)でもう少し柔軟に変更できる気がします。。。

【2】連結した文字列をクリップボードに格納する

クリップボードにデータを格納するにあたり、データオブジェクトという
少し特殊な機能を使います。

ライブラリ一覧から探すのは数が多すぎてちょっとめんどくさいので笑、
ユーザーフォームをいったん追加して削除することで参照設定だけ適用します。

'事前にライブラリの参照設定をしておく。
'ユーザーフォームの 追加 > 削除 でok。
'ライブラリ名:【Microsoft Forms 2.0 Object Library】

'~~(中略)~~

    With New MSForms.DataObject
        .SetText tmpStrings<br>'変数の値をDataObjectに格納する
        .PutInClipboard<br>'DataObjectのデータをクリップボードに格納する
    End With

また、そのまま貼り付けすると文字化けを起こす*1ので、メモ帳などのエディタを経由して変換します。

    MsgBox "格納しました。" & vbCrLf & _
                "一旦メモ帳に貼り付けてお使いください。"

私のレベルと時間の関係で今回はやめましたが、これも本当はコードで解決すると思います。ADOオブジェクトとやらで…?

【3】文字列を連結する

文字列の連結と言ったらJoin関数と思ったのですが、連結対象を
範囲(二次元配列)で渡す
ので動いてくれませんでした。
配列を取り出して改行を足して文字列に…とか考えてたらよく分からなくなってしまいました。笑

<2018/01/05追記>
WorksheetFunction.TRANSPOSE関数というものを使うと、
二次元配列を一次元に直してくれるというコメントをいただきました。ありがとうございます!
詳しい説明は、頂いた下記リンクをご参照ください。
thom.hateblo.jp

というわけで、現状(未修正)は1行ずつ取り出して
手動でつなげる流れです。

Private Function joinStrings(ByRef targetSheet As Worksheet, _
                             ByVal firstRow As Long, _
                             ByVal lastRow As Long, _
                             ByVal targetCol As Long) As String

    Dim results As String: results = targetSheet.Cells(firstRow, targetCol)
    
    Dim i As Long
    For i = firstRow + 1 To lastRow
        results = results & vbCrLf & targetSheet.Cells(i, targetCol)
    Next i

    joinStrings = results

End Function

イメージとしては、
----------------------
文 + 改行
文 + 改行
文 + 改行
~中略~
文 + 改行
+ 改行
---------------------- という動きです。
※最後は改行しません。

参照

【2】の部分は、ほぼ下記から拝借いたしました。
www.moug.net

いつもお世話になっております!

まとめ

ブログ用に簡素にしていますが、実際は入力欄とメール本文のシートを分けて、
顧客情報のページからコピペ→必要な情報を関数で抜き出して入力する形になっています。
完璧ではないので、操作自体はまだちょっとめんどくさいです。

ただ、少なくとも誤字脱字は減ったのと作業スピードは上がりました。
そもそも入力を間違えたら元も子もないですが…そこは最低限Wチェックでカバーするとして…

余裕が出来たら、入力欄はページ丸ごとコピペだけでデータを抽出できるといいな
と考えています。人間の操作は限りなく0に減らしたいですね。

今の業務では使っていないですが、今後Outlookも使うようになったら
送信まで自動化できそうだな~と。

あと、文字コード問題は早めに対処したいです。優先度高めで。

やりたいことだけ膨らんで実現まではなかなかたどり着かないのが残念ですが、
少しずつ時間を見つけて頑張ります。それでは!

注釈

*1: たぶん文字コード(Shift-JISとUnicode)の問題で…