メール自動作成用のクラスを作る~(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...

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

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