Thunderbirdメール自動作成マクロを改良した
準備
セルに名前をつける。
こんな具合に「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」と名付けたセルに書き込む。
セルに独自の名前を付けておくと、いちいちブックやシートの指定をせずに済むから楽。
実行
マクロをシート上のボタンに登録して、
ボタンをポチッ!
Thunderbirdのショートカットを選択して[OK]。
結果
ほれ、この通り、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)
としてやれば良い。
これでより一層便利になった。
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」を渡して呼び出し。
果たして、実行結果は……???
実行結果
実行以前にコンパイルエラーwww
結論
え? 当たり前、ですか?
そら知らなんだw サーセンwww
Select / Activateメソッドの極小ハマり
状況
ワークシート
こんな風にシートを準備して、
それぞれのシートはこんな風にカレンダーにした。
クラスモジュールのコード
「オブジェクト名」は「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
実行結果
ここまではうまいこと行くのだが……。
こんなエラーが出てしまう。
エラーの原因
エラーメッセージから、DaySelectorクラスのwriteStartTimeメソッドに問題があることはすぐに分かったが、処理があまりにも単純なので、かなりの時間、何が悪いのか分からなかった。
結局、シートがアクティブでないのに、そのシートのセルを選択/アクティベートしようとしたためにエラーになった、というだけのことだった。
コードの修正
startCell_.Select
を、
startCell_.Parent.Activate
startCell_.Select
にするだけ。たったこれだけ。
やっぱり、「Parent」プロパティは便利だ。
それはともかく、結構初歩的なところでハマることもある、というお話でした。
Wordから転記した表で小ハマリ……
前にコチラで紹介した、
Wordの表からExcelの表にデータを転記するマクロ
なんですが、またしても軽くハマったので、覚書も兼ねて上げておく。
第1段階
Wordのこんな表から、
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
実行結果
こんな風に転記された。
第2段階
転記してできた表に対して、次のような処理を行うことにした。
- 「吉岡タイトル」列(F列)を選択してマクロ実行
- 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」とか、アホ丸出しだが、許せしてください。
問題
唐突だが、ここで問題。
画像のように、F2セルを選択した状態で上記の「checkTitleOfYoshioka」を実行するとどうなると思いますか?
もちろん、私はF2セルに「○」が入ると思っていましたよ。だって、そうするつもりでコードを書いたんですから。
実行結果
エッーーーーーーー!!
「吉岡タイトル」欄に「○」がつくはずなのに、空欄のまま……。
わけがわからないのでステップ実行してみる。
変数「i」が「3」なので、「.Cells(objCell.Row, i)」すなわちC2セルの値は「吉岡 稔真」のはず。ということは、次の行に処理が移るはず。[F8]をポチッ!
は、はぁ~~~ん???
なんで「End If」のところへ行くのさ???
イミディエイト・ウインドウで確かめても「Range("C2").Value」は「吉岡 稔真」……。
だのに、どうしてこんなことになるのでしょうか!?
答えが分かったらコメント欄にどうぞ!
ヒント
イミディエイト・ウインドウに「?Range("C2").Value」と打ち込んで、[Enter]を押した直後の画像がこれ。勘のいい人ならこれで分かりますよね!
勘の悪い私は、気づくのに異様に時間がかかったんですけど……。
挑戦者求む!
ファイルのフルパスを簡単に取得する
はじめに
メール自動作成マクロ(その1/その2/その3/その4)では、添付ファイルをセットするために表の中に添付ファイルのフルパスを入力しておく必要があった。
しかし、「添付ファイルのフルパスの入力なんてめんどくせーよな!」と誰しも思う。だから、簡単に入力できる方法が必要だ。
そこで、今回は、
セルをダブルクリックしたらファイル選択ダイアログが出てきて、そこで選んだファイルのフルパスがセルに入力される
という方針でやってみよう。
今回も、おなじみのこの表を使う。この表のU列~AD列のセルにファイルのフルパスを書き込むためのマクロ、ということ。
「セルをダブルクリックしたら」なので、Worksheetオブジェクトのイベントプロシージャ・「Worksheet_BeforeDoubleClick」を使う。
コードの作成
イベントプロシージャを書くときは、プロジェクトエクスプローラで、対象のオブジェクト名をダブルクリックしたらいい。今回は、「Sheet1」のところをダブルクリック。
「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プロパティ)が空白の場合の対応。これが結構重要で、件名に空の文字列が渡されてしまうと、なぜかひどいことになるので注意。
- だから、空白の時は(3)で「無題」という文字列を与えて空白にならないようにする。
- (4)では、メールの本文の部分を作っている。基本、すでにMailBodyクラスのインスタンスが保持している文字列データを連結しているだけなので何も難しいことはないと思う。改行が「%0A」だということぐらいがポイントかな。
- (5)では、本文文字列中の「,」(半角カンマ)を全角に置換している。本文文字列中に半角カンマがあるとひどいことになるらしいので。
- (5')は、セル内の改行を、Thunderbirdの改行コード(って言うの?)「%0A」に置換。[Alt]+[Enter]によるセル内改行は「vblf」みたいですね。
※追記 - (6)で、添付ファイルのフルパスを連結している。連結時に「,」を加えているところがポイント。
- そうすると、連結文字列の最後が「,」になってしまうので、(7)で右端の「,」を除去。
ただし、この過程が必要なのかどうかは試していない。 - (8)では、添付ファイルフルパスを連結した文字列を「'」で括っている。こうすることで複数の添付ファイルを渡すことができるということなんだってさ。
- ここまでで下ごしらえは完了したので、後は基本構文の通りにデータを与えるだけ。(9)以下の8行がそうなんですけど、行継続文字でつないでいるので、実際は1行です。
実行準備
後々LotusNotesと使い分ける時のことも考えて、
こんなふうにしてみた。
それに伴って、標準モジュールのコードも少し書き換えた。
実行用のコード
まずは、宣言セクションで、
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から。
ウチのPCにはノーツが入っていないので当然こうなるw
んで、Thunderbird。
添付ファイルだって、
こんな風に準備して、
こんな風に入力しておくと、
ほれ、この通り、バッチリ添付されとる。
んで、上の画像だと、本文の上にミョーな空白ができるんですが、コチラによると、アカウントの設定で解消できる、とのこと。
Thunderbirdの「ツール」メニューから、
「アカウント設定」を選択し、
「編集とアドレス選択」に進み、
「HTML形式でメッセージを編集する」のチェックを外して実行すると、
ほれ、この通りミョーな空白はなくなっておる。
おわり
ちゃっちゃと書くつもりがまたしても異様に長くなってしまった。
LotusNotes版も一応できているので、近いうちにうpします。