Thunderbirdメール自動作成マクロを改良した

準備

セルに名前をつける。

f:id:akashi_keirin:20170318080804j:plain

こんな具合に「ThunderBirdPath」と名前をつけた。

標準モジュールのコード

Sub getThunderbirdPath()
  Set flp = New FilePicker                                  '……(1)
  With flp
  .showFilePicker ("Thunderbirdの実行ファイルを指定せよ(ショートカットでも良い)")  '……(2)
    If .isCancelled = False Then                            '……(3)
      Range("ThunderbirdPath").Value = .gotFileFullPath     '……(4)
    End If
  End With
End Sub

たったこんだけ。このときに作成した「FilePicker」クラスを使用。うん、メッチャ便利w 自作Functionでやっていた時期もあったけど、自作クラスの方が圧倒的に使い勝手がいい! アドヴァイスをくださったフォロワーさんに感謝!

どうでもいいけど、最近、EdgeでURLを選択して右クリックしたら、いきなりEdgeが落ちるんだけど、何なのこれ? 不便でしゃーないんやけど。

コードの説明

  • (1)でFilePickerクラスのインスタンスを生成。
  • (2)で、showFilePickerメソッドを呼び出す。引数で渡した文字列が、ウインドウのタイトルとして表示される。
    ※この引数はOptionalにした方が良いと思った。
  • (3)。ファイル選択をキャンセルしたら、isCancelledプロパティがTrueになるようにしているので、Falseだったら何らかのファイルフルパスがgotFileFullPathプロパティにセットされていることになる。
  • (4)でめでたく取得したファイルのフルパスを「ThunderbirdPath」と名付けたセルに書き込む。
    セルに独自の名前を付けておくと、いちいちブックやシートの指定をせずに済むから楽。

実行

マクロをシート上のボタンに登録して、

f:id:akashi_keirin:20170318081442j:plain

ボタンをポチッ!

f:id:akashi_keirin:20170318080810j:plain

Thunderbirdのショートカットを選択して[OK]。

結果

f:id:akashi_keirin:20170318080817j:plain

ほれ、この通り、Thunderbirdの実行ファイルのフルパスがセルにセットされた。

後は、このセルの値を引数として渡してThunderbirdメール作成メソッドを実行するようにしたら良い。

たとえば、このとき作成したメソッドだったら、まずメソッド名を

Public Sub createThunderbirdMail(ByVal tbp As String)

と、このように文字列を引数として受け取るようにしておいて、

Thunderbirdのフルパスを、

Dim thunderbirdPath As String
  thunderbirdPath = """" & THUNDERBIRD_PATH & """ -compose """

と、こんなふうに定数にしていたのを、

Dim thunderbirdPath As String
  thunderbirdPath = """" & tbp & """ -compose """

こんなふうに引数名に変えて、実行時に、

md.createThunderbirdMail (Range("ThunderbirdPath").Value)

としてやれば良い。

これでより一層便利になった。

@akashi_keirin on Twitter

VBAでは、メソッドのオーバーロードができなかった

やってみた。

準備

標準モジュールのコード

Private Sub makeUserSick()                       '……(1)
  MsgBox "     _________" & vbCrLf & _
         " /          \ " & vbCrLf & _
         "/ /・\  /・\    \" & vbCrLf & _
         "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
         "|    (_人_)    |" & vbCrLf & _
         "|     \     |          |" & vbCrLf & _
         "\      \_|     /"
End Sub

Private Sub makeUserSick(ByVal msg As String)               '……(2)
  MsgBox msg & vbCrLf & _
         "     _________" & vbCrLf & _
         " /          \ " & vbCrLf & _
         "/ /・\  /・\    \" & vbCrLf & _
         "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
         "|    (_人_)    |" & vbCrLf & _
         "|     \     |          |" & vbCrLf & _
         "\      \_|     /"
End Sub

説明

  • (1)の「makeUserSick」プロシージャは、引数なし。
  • (2)の「makeUserSick」プロシージャは、引数「msg」がある。

同じプロシージャ名で、違うのは引数の構成だけなので、これができるんなら、メソッドのオーバーロードが可能、ということになる。

実行

では、実行してみよう。

実行用のコード

Sub test()
  Call makeUserSick                     '……(1)
  Call makeUserSick("アホwww")       '……(2)
End Sub

コードの説明

  • (1)は、引数なしで呼び出し。
  • (2)は、引数として文字列「アホwww」を渡して呼び出し。

果たして、実行結果は……???

実行結果

f:id:akashi_keirin:20170318072916j:plain

実行以前にコンパイルエラーwww

結論

VBAでは、メソッドのオーバーロードはできません。

え? 当たり前、ですか?

そら知らなんだw サーセンwww

@akashi_keirin on Twitter

Select / Activateメソッドの極小ハマり

状況

ワークシート

f:id:akashi_keirin:20170315232338j:plain

こんな風にシートを準備して、

f:id:akashi_keirin:20170315232345j:plain

それぞれのシートはこんな風にカレンダーにした。

クラスモジュールのコード

「オブジェクト名」は「DaySelector」にしている。

Option Explicit
'フィールド
Private startCell_ As Range
Private endCell_ As Range
Private startTime_ As Date
Private endTime_ As Date
'アクセサ
Public Property Get startCell() As Range
  Set startCell = startCell_
End Property
Public Property Get endCell() As Range
  Set endCell = endCell_
End Property
Public Property Get startTime() As Date
  startTime = startTime_
End Property
Public Property Get endTime() As Date
  endTime = endTime_
End Property
'コンストラクタ
Private Sub Class_Initialize()
  Dim m As Integer
  Dim d As Integer
  m = Month(Now())
  d = Day(Now())
  Call setStartCell(m, d)
  Set endCell_ = startCell_.Offset(0, 1)
End Sub
Private Sub setStartCell(ByVal m As Integer, ByVal d As Integer)
  With ThisWorkbook
    If m > 3 And m < 13 Then
      With .Worksheets(m - 3)
        Set startCell_ = .Range("C" & d + 1)
      End With
    Else
      With .Worksheets(m + 9)
        Set startCell_ = .Range("C" & d + 1)
      End With
    End If
  End With
End Sub

'メソッド
Public Sub writeStartTime()
  If startCell_.Value = "" Then
    startCell_.Value = Format(Now(), "hh:mm")
    MsgBox "始業時刻を書き込みました。" & vbCrLf & _
           "修正する場合は、セルに時刻を直接入力してください。"
  End If
  startCell_.Select
End Sub
Public Sub writeEndTime()
  Dim res As Integer
  res = MsgBox(PROMPT:="終業時刻を書き込みますか?", Buttons:=vbYesNo)
  If res = vbYes Then
    endCell_.Value = Format(Now(), "hh:mm")
  End If
End Sub

標準モジュールのコード

Public ds As DaySelector

Workbookモジュールのコード

Option Explicit
Private Sub Workbook_Open()
  Set ds = New DaySelector
  ds.writeStartTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Set ds = New DaySelector
  ds.writeEndTime
End Sub

実行結果

f:id:akashi_keirin:20170315232350j:plain

f:id:akashi_keirin:20170315232359j:plain

ここまではうまいこと行くのだが……。

f:id:akashi_keirin:20170315232354j:plain

こんなエラーが出てしまう。

エラーの原因

エラーメッセージから、DaySelectorクラスのwriteStartTimeメソッドに問題があることはすぐに分かったが、処理があまりにも単純なので、かなりの時間、何が悪いのか分からなかった。

結局、シートがアクティブでないのに、そのシートのセルを選択/アクティベートしようとしたためにエラーになった、というだけのことだった。

コードの修正

startCell_.Select

を、

startCell_.Parent.Activate
startCell_.Select

にするだけ。たったこれだけ。

やっぱり、「Parent」プロパティは便利だ。

それはともかく、結構初歩的なところでハマることもある、というお話でした。

@akashi_keirin on Twitter

Wordから転記した表で小ハマリ……

前にコチラで紹介した、

Wordの表からExcelの表にデータを転記するマクロ

なんですが、またしても軽くハマったので、覚書も兼ねて上げておく。

第1段階

f:id:akashi_keirin:20170313230205j:plain

Wordのこんな表から、

f:id:akashi_keirin:20170313230211j:plain

Excelのこんな表にデータをマクロで転記した。

使用したコード

Option Explicit
Sub transferFromWordTable()
On Error GoTo myError
  Err.Clear
  Dim tgtRow As Integer
  tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row + 1
  Dim n As Integer
  n = tgtRow  '書き込み開始行を保持しておく
  '参照設定でWordのオブジェクトライブラリにチェックを入れている。
  Dim objWord As Word.Application
  Dim objDoc As Document
  Dim objFileName As String
  Dim objFolderName As String
  Set objWord = GetObject(, "Word.Application")
  Set objDoc = objWord.ActiveDocument
  objFileName = objDoc.Name
  objFolderName = ThisWorkbook.Path & "\★hogehoge\"
  With ThisWorkbook.Worksheets("Main")
    .Range("A" & tgtRow).Value = objWord.Selection.Text
    Dim i As Integer
    For i = 2 To 9
      .Range("B" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 1).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 1).Range.Text) - 1)
      .Range("C" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 2).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 2).Range.Text) - 1)
      .Range("D" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 3).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 3).Range.Text) - 1)
      .Range("E" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 4).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 4).Range.Text) - 1)
    Next
    tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row
    For i = n To tgtRow
      If .Range("B" & i).Value = vbCr Then
        .Range("B" & i).Value = ""
      End If
    Next
  End With
  objDoc.Close False
  If objWord.Documents.Count = 0 Then
    objWord.Quit
  End If
  Set objWord = Nothing
  Set objDoc = Nothing
  Name objFolderName & objFileName As _
       objFolderName & "転記済み\" & objFileName
  Exit Sub
myError:
  Debug.Print Err.Number & ":" & Err.Description
  Word.Application.Quit
End Sub

実行結果

f:id:akashi_keirin:20170313230218j:plain

こんな風に転記された。

第2段階

転記してできた表に対して、次のような処理を行うことにした。

  1. 「吉岡タイトル」列(F列)を選択してマクロ実行
  2. C列~E列を順に調べ、一つでも「吉岡 稔真」と書かれたセルがあったらF列に「○」をつける。

まあ、実にしょうもないマクロだが、こんなことをしたと思ってほしい。

使用したコード

Sub checkTitleOfYoshioka()
  Dim objCell As Range
  Set objCell = ActiveCell
  Dim i As Integer
  With ThisWorkbook.Worksheets("Main")
    For i = 3 To 5
      If .Cells(objCell.Row, i).Value = "吉岡 稔真" Then
        .Cells(objCell.Row, 6).Value = "○"
        Exit For
      End If
    Next
  End With
End Sub

プロシージャ名が「checkTitleOfYoshioka」とか、アホ丸出しだが、許してください。

問題

唐突だが、ここで問題。

f:id:akashi_keirin:20170313230224j:plain

画像のように、F2セルを選択した状態で上記の「checkTitleOfYoshioka」を実行するとどうなると思いますか?

もちろん、私はF2セルに「○」が入ると思っていましたよ。だって、そうするつもりでコードを書いたんですから。

実行結果

f:id:akashi_keirin:20170313230242j:plain

エッーーーーーーー!!

「吉岡タイトル」欄に「○」がつくはずなのに、空欄のまま……。

わけがわからないのでステップ実行してみる。

f:id:akashi_keirin:20170313230251j:plain

変数「i」が「3」なので、「.Cells(objCell.Row, i)」すなわちC2セルの値は「吉岡 稔真」のはず。ということは、次の行に処理が移るはず。[F8]をポチッ!

f:id:akashi_keirin:20170313230301j:plain

は、はぁ~~~ん???

なんで「End If」のところへ行くのさ???

f:id:akashi_keirin:20170313230349j:plain

イミディエイト・ウインドウで確かめても「Range("C2").Value」は「吉岡 稔真」……。

だのに、どうしてこんなことになるのでしょうか!?

答えが分かったらコメント欄にどうぞ!

ヒント

f:id:akashi_keirin:20170313230401j:plain

イミディエイト・ウインドウに「?Range("C2").Value」と打ち込んで、[Enter]を押した直後の画像がこれ。勘のいい人ならこれで分かりますよね!

勘の悪い私は、気づくのに異様に時間がかかったんですけど……。

挑戦者求む!

@akashi_keirin on Twitter

ファイルのフルパスを簡単に取得する

はじめに

メール自動作成マクロ(その1その2その3その4)では、添付ファイルをセットするために表の中に添付ファイルのフルパスを入力しておく必要があった。

しかし、「添付ファイルのフルパスの入力なんてめんどくせーよな!」と誰しも思う。だから、簡単に入力できる方法が必要だ。

そこで、今回は、

セルをダブルクリックしたらファイル選択ダイアログが出てきて、そこで選んだファイルのフルパスがセルに入力される

という方針でやってみよう。

f:id:akashi_keirin:20170311114734j:plain

f:id:akashi_keirin:20170311114741j:plain

f:id:akashi_keirin:20170311114749j:plain

今回も、おなじみのこの表を使う。この表のU列~AD列のセルにファイルのフルパスを書き込むためのマクロ、ということ。

「セルをダブルクリックしたら」なので、Worksheetオブジェクトのイベントプロシージャ・「Worksheet_BeforeDoubleClick」を使う。

コードの作成

f:id:akashi_keirin:20170312205644j:plain

イベントプロシージャを書くときは、プロジェクトエクスプローラで、対象のオブジェクト名をダブルクリックしたらいい。今回は、「Sheet1」のところをダブルクリック。

f:id:akashi_keirin:20170312205647j:plain

「Sheet1」モジュールのコードウインドウが表示されるので、上の2つの窓でそれぞれ「Worksheet」(左)と「BeforeDoubleClick」を選択すると、

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

End Sub

ってのが自動的に生成されるので、真ん中のところにコードを書いていきゃいい。

シートモジュールのコード

Option Explicit

Const PROMPT As String = "添付するファイルを指定してください。"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
  Err.Clear
  Application.EnableEvents = False                                        '……(1)
  Set flp = New FilePicker                                                '……(2)
  With Target
    If .Column < colNum.att01 Or .Column > colNum.att10 Or .Row = 1 Then  '……(3)
      Application.EnableEvents = True                                     '……(4)
      Exit Sub
    Else                                                                  '……(5)
      '添付ファイルが歯抜け状態で入力されないようにするための措置
      If .Column > colNum.att01 And .Offset(0, -1).Value = "" Then
        MsgBox "添付ファイルは左詰めになるように設定せよ。" & vbCrLf & "やり直すがよい。"
        Cancel = True                                                     '……(6)
        Application.EnableEvents = True
        Exit Sub
      End If
      flp.showFilePicker PROMPT                                           '……(7)
      If flp.isCancelled = True Then                                      '……(8)
        Cancel = True
        Application.EnableEvents = True
        Exit Sub
      End If
      If LenB(flp.gotFileFullPath) > 220 Then                             '……(9)
        MsgBox "添付ファイルのフルパスのサイズが220バイトを超えています。" & vbCrLf & _
        "添付ファイルをデスクトップに貼り付けるなど、フルパスを短くしてください。"
        Cancel = True
        Application.EnableEvents = True
        Exit Sub
      Else
        .Value = flp.gotFileFullPath                                      '……(10)
        Cancel = True
      End If
    End If
  End With
  Application.EnableEvents = True                                         '……(11)                                    
  If Err.Number > 0 Then
    If Err.Number = 1004 Then
      MsgBox "指定したファイル名(フルパス)が長すぎます。" & vbCrLf & _
             "フルパスが短くなるようにして、やり直してください。" & vbCrLf & _
             "【例】添付ファイルをデスクトップに貼り付けるなど"
    End If
    Call errorCatch("WorkSheets(""Main"")のWorksheet_BeforeDoubleClickプロシージャ", Err.Number, Err.Description)
  End If
  Application.EnableEvents = True
End Sub

コードの説明

このブログでイベントマクロを紹介するのは初めてだと思うので、自分の復習も兼ねてちょっとこってり書いておこう。

  • (1)で一旦イベントの発生を抑える。実は、今回のこのマクロだけだったらこれは必要ないんだけど、このシートではもう一つ「Worksheet_Change」というイベントマクロも書いているので、イベントの連鎖を防ぐためにこうしている。いきなり分かりにくくてすまん。
  • (2)では自作クラスFilePickerをインスタンス化。FilePickerのコードはコチラをどうぞ。
  • (3)では、ダブルクリックされた場所を判定。添付ファイル入力欄以外なら(4)に進む。
    ちなみに、列番号の指定はおなじみ列挙体を使用しています。(コチラを参考にどうぞ。)
  • (4)に処理が移るということは、添付ファイル入力欄ではないということだから、イベントの発生抑止を解除して処理を終了する。処理を終了するときに「Application.EnableEvents」をTrueにしておかないと、いろいろおかしなことになるから注意。
    ※ダブルクリックしたのに何も起こらない、とか。
  • (5)に処理が移ってくるということは、添付ファイル入力欄上でダブルクリックされた、ということ。
  • ただし、ダブルクリックされたセルが添付ファイル2~10までのセルなのに、左隣のセルが空白だったら、歯抜け状態になっているとみなしてメッセージを表示して終了する。
  • (6)の「Cancel = True」というのは「ダブルクリック」というイベントをキャンセルする、ということ。ふつうセルでダブルクリックしたら、編集モードに移るんだけど、それをキャンセルするので何も起こらない。要するに直接入力もさせない、ということだ。
  • ここまでの条件をクリアしてきたら、それは、「ダブルクリックされたセルが添付ファイルのフルパスを入力しても良いセル」ということになる。そこで、(7)、FilePickerクラスのshowFilePickerメソッドの出番だ。ファイル選択ダイアログのタイトル欄に表示する文字列を引数として渡して実行する。
  • (8)。ファイル選択ダイアログで[キャンセル]が選ばれたりしてファイルパスが取得できていなければ、isCancelledプロパティがTrueになっているので、処理を終了する。
  • (9)は、取得したファイルフルパスのバイト数でふるいにかけている。添付ファイルのフルパスが長いと添付できないことがあるから。ここではそのバイト数を220にしているけど、これは目分量みたいなもん。正確なところが分からないので、知っている人がいたら教えてください。
  • ここまで、数々の苦難を乗り越えて(10)まで来たら、やっとここで取得したファイルのフルパスをダブルクリックしたセルに書き込んでいる。
  • 最後に(11)のようにイベント発生を復活させておくのを忘れないように。

イベントマクロって、便利なんですけど、思いもかけないタイミングで発動することがあるので、慣れないうちは試行錯誤が必要ですね。ダブルクリックイベントなんかの場合、単独ではイベントの無限連鎖にはならないんだけど、他のイベントマクロとの合わせ技で無限連鎖が起こってしまうことがあるのでやっかいです。

【参考】クラスモジュールFilePickerのコード

Option Explicit

'フィールド
Private gotFileFullPath_ As String
Private isCancelled_ As Boolean
'アクセサ
Public Property Get gotFileFullPath() As String
  gotFileFullPath = gotFileFullPath_
End Property
Public Property Get gotFileName() As String
  gotFileName = Right(gotFileFullPath_, _
                     (Len(gotFileFullPath) - InStrRev(gotFileFullPath, "\")))
End Property
Public Property Get isCancelled() As Boolean
  isCancelled = isCancelled_
End Property
'コンストラクタ
Private Sub Class_Initialize()
  isCancelled_ = False
End Sub
'メソッド
Public Sub showFilePicker(ByVal titleStr As String)
  Dim fileFullPath As Variant
  fileFullPath = Application.GetOpenFilename(Title:=titleStr)
  If fileFullPath = False Then
    isCancelled_ = True
    gotFileFullPath_ = ""
  Else
    isCancelled_ = False
    gotFileFullPath_ = fileFullPath
  End If
End Sub

【参考】標準モジュールのコード

'列挙体(列名を表すのに使用)
Public Enum colNum
  isSent = 1
  numOf
  sendTo
  mailTo
  CC
  BCC
  mailSubj
  belongsTo
  jobTitle
  personName
  p01
  p02
  p03
  p04
  p05
  p06
  p07
  p08
  p09
  p10
  att01
  att02
  att03
  att04
  att05
  att06
  att07
  att08
  att09
  att10
  returnReceipt
End Enum
'クラス変数
Public flp As FilePicker

おわりに

ここまで来ると、かなり便利なツールになってきます。

メール自動作成用のクラスを作る~(4)……そして伝説へ(うそ)

LotusNotesメールを作る

LotusNotes版も作った。……ていうか、前から使っていたやつを移植しただけですが。

早速、コードの紹介から。このとき作ったクラスに追記する。

メソッドのコード

Public Sub createLotusNotesMail()
On Error Resume Next
  Err.Clear
  'LotusNotesのメールを作成する
  Dim notesSession As Object         'NotesSession                    '……(1)
  Dim notesDatabase As Object        'NotesDatabase
  Dim notesDocument As Object        'NotesDocument
  Dim notesRichTextItem As Object    'NotesRichTextItem
  Dim notesRichTextStyle As Object   'NotesRichTextStyle
  Dim notesEmbeddedObject As Object  'NotesEmbeddedObject
  Dim notesUIWorkSpace As Object     'NotesUIWorkspace
  Dim notesUIDocument As Object      'NotesUIDocument
  'Notesのセッションを起動する
  Set notesSession = CreateObject("Notes.NotesSession")               '……(2)
  Set notesUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
  'NotesDatabaseオブジェクトを作成し、そのデータベースを開く
  Set notesDatabase = notesSession.GetDatabase("", "")
  'NotesDBをユーザーのメールDBに割り当てた後に開く
  notesDatabase.OpenMail
  'メール作成の準備
  'NotesDBに文書を作成し、新規文書をオブジェクト変数にセットする
  Set notesDocument = notesDatabase.CreateDocument()                  '……(3)

 

With notesDocument                                                  '……(4)
    '件名をセットする
    .Subject = mailSubject_
    '宛先をセットする
    .sendTo = mailTo_
    'CCがあればセット
    If CC_ <> "" Then
      .CopyTo = CC_
    End If
    'BCCがあればセット
    If BCC_ <> "" Then
      .blindCopyTo = BCC_
    End If
    '受信確認の有無をセット
    .returnReceipt = returnReceipt_
  End With

 

  '文書にリッチテキストアイテムを作成する
  Set notesRichTextItem = notesDocument.CreateRichTextItem("BODY")    '……(5)
  Set notesRichTextStyle = notesSession.CreateRichTextStyle("BODY")   '……(6)
  '本文のフォントサイズを設定
  notesRichTextStyle.FontSize = MAIN_FONTSIZE                         '……(7)

 

  '本文をセットする
  With notesRichTextItem                                              '……(8)
    '本文のフォントスタイルをセット
    .appendStyle notesRichTextStyle                                   '……(9)
    '送信相手の所属、職名、名前をセット
    .appendText belongsTo_                                            '……(10)
    .addNewLine 1
    .appendText " " & jobTitle_ & " " & personName_ & " 様"
    .addNewLine 3

 

    '本文をセット                                                     '……(11)
    Dim i As Integer
    If numOfBody_ <> 0 Then
      For i = 1 To numOfBody_
        .appendText mailBody_(i)
        .addNewLine 2
      Next
    End If
    .addNewLine 2
    '本文以外のフォントサイズを設定                                   '……(12)
    notesRichTextStyle.FontSize = SUB_FONTSIZE
    '本文以外のフォントスタイルをセット
    .appendStyle notesRichTextStyle

 

    '添付ファイルをセット                                             '……(13)
    If numOfAttFiles_ <> 0 Then
      For i = 1 To numOfAttFiles_
        Set notesEmbeddedObject = .EmbedObject(EMBED_ATTACHMENT, "", attFiles_(i))
        .addTab 1
        .addNewLine 1
      Next
    End If

 

    '署名をセット                                                     '……(14)
    .addNewLine 3
    .appendText "==============================="
    .addNewLine 1
    .appendText senderData_(1)
    .addNewLine 1
    .appendText " " & senderData_(2)
    .addNewLine 1
    .appendText "  " & senderData_(3) & "  " & senderData_(4)
    .addNewLine 1
    .appendText senderData_(5)
    .addNewLine 1
    .appendText " " & senderData_(6)
    .addNewLine 1
    .appendText " TEL   " & senderData_(7)
    .addNewLine 1
    .appendText " FAX   " & senderData_(8)
    .addNewLine 1
    .appendText " Email " & senderData_(9)
    .addNewLine 1
    .appendText "==============================="
    .addNewLine 1
  End With

 

  ' メールを保存する。これをやらないとRichTextItemの編集が表示されない
  notesDocument.Save False, False
  ' メールを編集状態にする
  Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
  'エラーキャッチ
  If Err.Number > 0 Then
    Call errorCatch("MailDataクラスのcreateLotusNotesMailメソッド", Err.Number, Err.Description)
    MsgBox "【Main】シートへの入力に不備がなかったか、確認してやり直してください。", vbCritical
  End If
On Error GoTo 0
  ' オブジェクト変数を解放する
  Set notesEmbeddedObject = Nothing
  Set notesRichTextItem = Nothing
  Set notesDocument = Nothing
  Set notesUIDocument = Nothing
  Set notesDatabase = Nothing
  Set notesSession = Nothing
  Set notesUIWorkSpace = Nothing
End Sub

コードの説明

例によってコードを説明していこう。基本的な部分は、このとき説明したので省略。もちろん、その当時から大して成長していないのでw、あのとき分からなかったことは、今以て分からないままですw

  • (1)は、見ての通り変数の宣言。たかがメール1本作るのにこんなにたくさんのオブジェクトが絡んでるんですねえ。Thunderbirdとはえらい違いだw
  • (2)は、コメントにもある通り「ノーツのセッション」とやらをインスタンス化している。……と書いている自分でも抽象的すぎて何のことかわからねえよ!
  • (3)まで来るとやっとちょっと分かってくるぞ。NotesDocumentというものをインスタンス化しとるわけだ。
  • (4)で、「NotesDocument」の諸属性をセットしている。NotesDocumentってのは、「1本のメール全体」ぐらいのイメージなんでしょうね。
  • (5)では、CreateRichTextItemというメソッドを使って、RichTextItemってのをインスタンス化している。先のNotesDocumentオブジェクトの中にRichTextItemオブジェクトがある、というイメージなんでしょうね。
  • (6)では、RichTextStyleってのをインスタンス化している。NotesSessionクラスのメソッドを使っているところを見ると、NotesSessionオブジェクトの中にRichTextStyleオブジェクトがある、というイメージなんでしょうね。
  • (7)では、RichTextStyleのFontSizeというフィールドに値を設定して、フォントサイズを決めている。RichTextItemとRichTextStyleってのはHTMLとCSSみたいな関係なんですかね。
  • (8)からはいよいよRichTextItemの作成。
  • (9)では、AppendStyleメソッドでRichTextStyleで設定したスタイルを適用している。
  • (10)からは、まず宛名部分を作っている。とても原始的なやり方ですw AppendTextメソッドで文字列を追加して、AddNewLineで行を追加していく、というのが基本みたい。
  • (11)では本文を追加している。他のパーツと違って、本文は配列で持たせているので、このようにForループで追加している。
  • (12)からは、本文以外の部分(添付ファイルと署名)なので、フォントサイズを下げている。
  • (13)は、添付ファイルの埋め込み。添付ファイルのフルパスを配列で持たせているので、これまたForループでおk。
    RichTextItemクラスのメソッドでインスタンス化されているところからすると、添付ファイルは、RichTextItemオブジェクトの配下のEmbeddedObject(埋め込まれたオブジェクト)というオブジェクトとして管理されているんですねえ。
  • (14)以下のところで署名部分を作っている……んですけど、なんか、あまりにも原始的ですよねえ……。
    手動でメールを作るときには、HTMLで作った署名が自動で挿入されるんですから、そういうやり方があるはずなんですけど、未だによく分かりません。雰囲気からして署名なんかもEmbeddedObjectっぽんですけどねえ……。知っている人がいたら教えてください。

メソッド呼び出しのコード

2段階で呼び出すことにする。つまり、

  • LotusNotesが起動しているかどうかチェック
  • 起動していたら、引数を渡してメインメソッドを呼び出す

てな感じ。

第1段階のコード

Sub callLotusNotes()
  Set nsc = New NotesStartedChecker                   '……(1)
  With nsc
    .checkNotesIsStarted _
      "ちょwww おまwww" & vbCrLf & _
      "LotusNotesが起動してないしwww" & vbCrLf & _
      "LotusNotesを起動・ログインして出直してこいやwww" & vbCrLf & _
      "     _________" & vbCrLf & _
      " /          \ " & vbCrLf & _
      "/ /・\  /・\    \" & vbCrLf & _
      "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
      "|    (_人_)    |" & vbCrLf & _
      "|     \     |          |" & vbCrLf & _
      "\      \_|     /"
    If .isStarted = False Then
      Set nsc = Nothing
    Else
      Set nsc = Nothing
      Call voidMain(APP_LOTUSNOTES)                   '……(2)
    End If
  End With
End Sub

コードの説明

  • (1)の「NotesStartedChecker」ってのは、このとき作ったやつです。このクラスのcheckNotesIsStartedメソッドは、引数としてノーツが起動していなかったときの注意書き文字列を渡して実行します。無駄に長いテキストを渡してすんません。
  • checkNotesIsStartedメソッドを実行すると、ノーツが起動していたら「isStarted」プロパティにTrueを、起動していなかったらFalseがセットされる。今にして思えば、あっさりBoolean型のFunctionにすりゃ良かったんですね。
  • ノーツが起動していたら、(2)でノーツであることを表す引数を渡してvoidMainメソッドを呼び出す、という仕掛け。

第2段階のコード(再掲)

Sub voidMain(ByVal appNum As Integer)
  Dim baseCell As Range
  Set baseCell = ActiveCell
  If booleanCheckActiveCell(baseCell) = False Then
    Call makeUserSick
    Set baseCell = Nothing
    Exit Sub
  End If
  Dim objSh As Worksheet
  Set objSh = baseCell.Parent
  Dim n As Integer  'カウント用変数
  Dim baseRow As Long
  baseRow = baseCell.Row
  '構造体変数mldtに、メールの基本情報をセットする
  Call setMailBasicData(baseCell)
  Set md = New MailData
  'MailBodyクラスのインスタンスにメールの基礎データをセット
  md.getMailBasicData mldt                '……(1)
  '本文文字列の入っているセルを数えて変数「n」にセット
  Dim i As Integer
  n = 0
  For i = colNum.p01 To colNum.p10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '本文を配列に格納する。
  Call setMailBody(baseCell, n)
  'MailDataクラスのインスタンスにメール本文の配列をセット
  md.getMailBodyArray mlBody()
  '添付ファイルのフルパスが入っているセルを数えて変数「n」にセット
  n = 0
  For i = colNum.att01 To colNum.att10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '添付ファイルのフルパスを配列に格納する。
  Call setAttachmentFiles(baseCell, n)
  '添付ファイルフルパスの取得に失敗していたら処理を終了
  If isFailed = True Then
    Set md = Nothing
    Exit Sub
  End If
  'MailDataクラスのインスタンスに添付ファイルフルパスの配列をセット
  md.getMailAttFilesArray mlAttFiles()
  '送信者データを配列に格納する
  Call setSenderData(Range("UserInformationTable").Rows.Count)
  'MailDataクラスのインスタンスにユーザー情報の配列をセット
  md.getSenderDataArray mlSenderData()
  If appNum = 0 Then
    Call test
    Set md = Nothing
    Exit Sub
  End If
  If appNum = APP_LOTUSNOTES Then
    'LotusNotesでメールを作成する
    md.createLotusNotesMail
  End If
  If appNum = APP_THUNDERBIRD Then
    'Thunderbirdでメールを作成する
    md.createThunderbirdMail
  End If
  objSh.Cells(baseRow, colNum.isSent).Value = "済"
  Set flp = Nothing
  Set md = Nothing
End Sub

コードの説明

再掲ゆえ省略。前回を参考にしてください。

おわりに

ノーツは職場のPCにしかないので、ちゃんと動くのかどうかは分かりません。 今回、コードの説明を書いてみて、ちょっとづつLotusNotesメールのオブジェクト構成とかが分かってきたような気がするので、LotusScriptのクラスリファレンスなんかを読みながら理解を深めていこうかなあという気がしなくもない。

Special Thanks To...

今回のコードを作成するにあたっては、コチラのページと、コチラのページを大いに参考にさせていただきました。

ありがとうございました。

メール自動作成用のクラスを作る~(3)

Thunderbirdでメールを自動作成するメソッドを作成。

まずはコードをご覧に入れよう。

あ、その前に、標準モジュールの宣言セクションに、

Public Const THUNDERBIRD_PATH As String = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"

こいつを追加。Thunderbirdでメールを作成するときには、Shell関数というものを用いるんですが、その引数に実行ファイルのフルパスがいるので、定数に放り込んであるわけです。もちろん、お使いの環境に合わせて変更が必要。

それじゃ、気を取り直してコードのご紹介。

Thunderbirdのメール自動作成メソッド

コード

Public Sub createThunderbirdMail()
  'Shell関数の引数を作る
  Dim thunderbirdPath As String
  thunderbirdPath = THUNDERBIRD_PATH & "-compose "  '……(1)
  '件名をセット                                                         '……(2)
  If mailSubject_ = "" Then
    mailSubject_ = "無題"                                               '……(3)
  End If
  '左肩部分をセット
  Dim strBody As String                                                 '……(4)
  strBody = belongsTo_ & "%0A" & " " & _
            jobTitle_ & " " & _
            personName_ & " 様"
  '左肩部分の下に2行文空行をセット
  strBody = strBody & "%0A" & "%0A" & "%0A"
  '本文をstrBodyに連結していく
  Dim i As Integer
  For i = 1 To numOfBody_
    strBody = strBody & mailBody_(i) & "%0A" & "%0A"
  Next
  strBody = Replace(strBody, ",", ",")                                 '……(5)
  strBody = Replace(strBody, vblf, "%0A"                                '……(5')
  '添付ファイルフルパスをつなぐ
  Dim strAttFile As String                                              '……(6)
  For i = 1 To numOfAttFiles
    strAttFile = strAttFile & attFiles_(i) & ","
  Next
  '右端の「,」を除去する                                                '……(7)
  If Right(strAttFile, 1) = "," Then
    strAttFile = Left(strAttFile, Len(strAttFile) - 1)
  End If
  '両端を「'」で囲む。
  strAttFile = "'" & strAttFile & "'"                           '……(8)
  'メールを作成する                                                     '……(9)
  Shell thunderbirdPath & _
    "to=" & mailTo_ & "," & _
    "cc=" & CC_ & "," & _
    "bcc=" & BCC_ & "," & _
    "subject=""" & mailSubject_ & """," & _
    "body=""" & strBody & """," & _
    "attachment=""" & strAttFile & """"
End Sub

解説の前に基本方針をば。Shell関数でThunderbirdメールを作るときの基本構文は、

Shell "Thunderbird実行ファイルのフルパス -compose _
to=送信先メールアドレス, _
cc=CCアドレス, _
subject=メール件名, _
body=本文文字列, _
attachment='添付ファイルフルパス'"

というものらしい。だから、それぞれのパーツ(実行ファイルのフルパスとか、「-compose」というスイッチとか、メールアドレスなんかの必要な文字列)は、全て一旦変数に入れてから使用することにする(コード中の(9)のところ)。

添付ファイルが複数あるときは、フルパスを「,」(カンマ)で区切って、全体を「'」(シングルクォート)で括る、ということなんだけれども、別に一つだけを「'」で括ろうが、添付ファイルなしで「attachment=」の右辺が「''」になっていようが問題ないっぽい。

コードの解説

  • (1)では、Shell関数に与える引数と、メール作成用のスイッチ(なのかな?)をセットにした文字列を一旦変数「thunderbirdPath」に格納している。「"」のエスケープの関係で、「"」の対応関係がめちゃくちゃややこしくなっています。誰か上手に説明できる人がいたら説明お願いします。
    【20190428追記】
    どうも、アホみたいに「"」を入れる必要がないようだったので、シンプルに修正しました。
  • (2)は、件名(MailDataオブジェクトのmailSubjectプロパティ)が空白の場合の対応。これが結構重要で、件名に空の文字列が渡されてしまうと、なぜかひどいことになるので注意。
    f:id:akashi_keirin:20170312095051j:plain
  • だから、空白の時は(3)で「無題」という文字列を与えて空白にならないようにする。
  • (4)では、メールの本文の部分を作っている。基本、すでにMailBodyクラスのインスタンスが保持している文字列データを連結しているだけなので何も難しいことはないと思う。改行が「%0A」だということぐらいがポイントかな。
  • (5)では、本文文字列中の「,」(半角カンマ)を全角に置換している。本文文字列中に半角カンマがあるとひどいことになるらしいので。
  • (5')は、セル内の改行を、Thunderbirdの改行コード(って言うの?)「%0A」に置換。[Alt]+[Enter]によるセル内改行は「vblf」みたいですね。
    ※追記
  • (6)で、添付ファイルのフルパスを連結している。連結時に「,」を加えているところがポイント。
  • そうすると、連結文字列の最後が「,」になってしまうので、(7)で右端の「,」を除去。
    ただし、この過程が必要なのかどうかは試していない。
  • (8)では、添付ファイルフルパスを連結した文字列を「'」で括っている。こうすることで複数の添付ファイルを渡すことができるということなんだってさ。
  • ここまでで下ごしらえは完了したので、後は基本構文の通りにデータを与えるだけ。(9)以下の8行がそうなんですけど、行継続文字でつないでいるので、実際は1行です。

実行準備

後々LotusNotesと使い分ける時のことも考えて、

f:id:akashi_keirin:20170312095059j:plain

こんなふうにしてみた。

それに伴って、標準モジュールのコードも少し書き換えた。

実行用のコード

まずは、宣言セクションで、

Public Const APP_LOTUSNOTES As Integer = 1
Public Const APP_THUNDERBIRD As Integer = 2

二つの定数を宣言。

前回作成したメインのコードを少し書き換える。

Sub voidMain(ByVal appNum As Integer)                      '……(1)
  Dim baseCell As Range
  Set baseCell = ActiveCell
  If booleanCheckActiveCell(baseCell) = False Then
    Call makeUserSick
    Set baseCell = Nothing
    Exit Sub
  End If
  Dim objSh As Worksheet
  Set objSh = baseCell.Parent
  Dim n As Integer  'カウント用変数
  Dim baseRow As Long
  baseRow = baseCell.Row
  '構造体変数mldtに、メールの基本情報をセットする
  Call setMailBasicData(baseCell)
  Set md = New MailData
  'MailBodyクラスのインスタンスにメールの基礎データをセット
  md.getMailBasicData mldt                '……(1)
  '本文文字列の入っているセルを数えて変数「n」にセット
  Dim i As Integer
  n = 0
  For i = colNum.p01 To colNum.p10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '本文を配列に格納する。
  Call setMailBody(baseCell, n)
  'MailDataクラスのインスタンスにメール本文の配列をセット
  md.getMailBodyArray mlBody()
  '添付ファイルのフルパスが入っているセルを数えて変数「n」にセット
  n = 0
  For i = colNum.att01 To colNum.att10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '添付ファイルのフルパスを配列に格納する。
  Call setAttachmentFiles(baseCell, n)
  '添付ファイルフルパスの取得に失敗していたら処理を終了
  If isFailed = True Then
    Set md = Nothing
    Exit Sub
  End If
  'MailDataクラスのインスタンスに添付ファイルフルパスの配列をセット
  md.getMailAttFilesArray mlAttFiles()
  '送信者データを配列に格納する
  Call setSenderData(Range("UserInformationTable").Rows.Count)
  'MailDataクラスのインスタンスにユーザー情報の配列をセット
  md.getSenderDataArray mlSenderData()
  If appNum = APP_LOTUSNOTES Then                                     '……(2)
    'LotusNotesでメールを作成する
    md.createLotusNotesMail
  End If
  If appNum = APP_THUNDERBIRD Then
    'Thunderbirdでメールを作成する
    md.createThunderbirdMail
  End If
  objSh.Cells(baseRow, colNum.isSent).Value = "済"
  Set flp = Nothing
  Set md = Nothing
End Sub

余計なDebug.Printを消したのでちょっと短くなった。

んで、標準モジュールに次の二つのメソッドを追加。

Sub callLotusNotes()
  Set nsc = New NotesStartedChecker
  With nsc
    .checkNotesIsStarted _
      "ちょwww おまwww" & vbCrLf & _
      "LotusNotesが起動してないしwww" & vbCrLf & _
      "LotusNotesを起動・ログインして出直してこいやwww" & vbCrLf & _
      "     _________" & vbCrLf & _
      " /          \ " & vbCrLf & _
      "/ /・\  /・\    \" & vbCrLf & _
      "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
      "|    (_人_)    |" & vbCrLf & _
      "|     \     |          |" & vbCrLf & _
      "\      \_|     /"
    If .isStarted = False Then
      Set nsc = Nothing
    Else
      Set nsc = Nothing
      Call voidMain(APP_LOTUSNOTES)                                   '……(3)
    End If
  End With
End Sub

Sub callThunderbird()
  Call voidMain(APP_THUNDERBIRD)                                      '……(4)
End Sub

コードの説明

  • (1)で、voidMainを引数を渡して呼び出すようにした。その引数でLotusNotesとThunderbirdを切り替えよう、というわけ。
  • (2)以下が切り替え処理。引数によってメソッドを使い分けるようにしている。
  • (3)がLotusNotes用のメソッド呼び出し。
  • (4)がThunderbird用の呼び出し。

実行

まずは、LotusNotesから。

f:id:akashi_keirin:20170312095119j:plain

ウチのPCにはノーツが入っていないので当然こうなるw

んで、Thunderbird

f:id:akashi_keirin:20170312095126j:plain

f:id:akashi_keirin:20170312095130j:plain

添付ファイルだって、

f:id:akashi_keirin:20170312095135j:plain

こんな風に準備して、

f:id:akashi_keirin:20170312095142j:plain

こんな風に入力しておくと、

f:id:akashi_keirin:20170312095146j:plain

ほれ、この通り、バッチリ添付されとる。

んで、上の画像だと、本文の上にミョーな空白ができるんですが、コチラによると、アカウントの設定で解消できる、とのこと。

f:id:akashi_keirin:20170312095151j:plain

Thunderbirdの「ツール」メニューから、

f:id:akashi_keirin:20170312095155j:plain

「アカウント設定」を選択し、

f:id:akashi_keirin:20170312095202j:plain

「編集とアドレス選択」に進み、

f:id:akashi_keirin:20170312095209j:plain

「HTML形式でメッセージを編集する」のチェックを外して実行すると、

f:id:akashi_keirin:20170312095215j:plain

ほれ、この通りミョーな空白はなくなっておる。

おわり

ちゃっちゃと書くつもりがまたしても異様に長くなってしまった。

LotusNotes版も一応できているので、近いうちにうpします。