小さなクラスを作る(3)～ファイルを選択させる

ファイルを選択させるやつも作ってみた。

例によってクラスモジュールを挿入。オブジェクト名は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         '……(1)
  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                       '……(2)
  fileFullPath = Application.GetOpenFilename(Title:=titleStr)
  If fileFullPath = False Then                      '……(3)
    isCancelled_ = True
    gotFileFullPath_ = ""
  Else
    isCancelled_ = False
    gotFileFullPath_ = fileFullPath
  End If
End Sub

もはやほとんど解説の必要もないと思うので、要点だけ。

• (1)は、gotFileNameプロパティの取得だが、Privateの仮変数を使っていない。フルパスが分かったら自ずと決まるものなので、必要なときのみ演算するようにした方がいいと思いました。「アホか」と思った上級者の方、ぜひご指摘ください。
• (2)でGetOpenFileNameの結果を受け取る変数をVariant型にしている。これは、ファイル選択ダイアログで[キャンセル]が選ばれると、Booleanの値を返すため。Variantとか、雑な仕事のような気がしてあんまり使いたくないんだけど。
• (3)はだから、[キャンセル]が選ばれたとき、ということ。isCancelled_をTrueにして、gotFileFullPath_には""を入れている。

標準モジュールに下記のコードを書いて実行。

Public flp As FilePicker
Sub test03()
  Set flp = New FilePicker
  With flp
    flp.showFilePicker "ファイルを選べ。"
    If .isCancelled = False Then
      MsgBox "ファイルのフルパス：" & .gotFileFullPath & vbCrLf & _
             "ファイル名：" & .gotFileName
    Else
      MsgBox "キャンセルされとるよ。"
    End If
  End With
End Sub

ファイルを選ぶと、

gotFileFullPathプロパティには選んだファイルのフルパスが、gotFileNameプロパティには選んだファイルのファイル名が、それぞれセットされていることが分かる。

引数でFileFilterとかMultiSelectに対応できるようにするなど、改良次第でかなり便利になりそうだ。

コチラのページ（mougモーグ）を参考に、追々改良していこう。

@akashi_keirin on Twitter

小さなクラスを作る(2)～他のアプリケーションの起動チェック

LotusNotesのメールをExcelVBAで自動作成するときは、そもそも自分のアカウントでNotesに接続していないといけない。

「でも、他のアプリケーションが起動しているかどうかなんて、どうやって判定できるんだろ？」とggっていてわりかしあっさりとたどり着いたのが、Office TANAKA「実行中のタスク一覧（非API）」という記事。

なるほどね～、と思ったので、即導入し、今に至る。

今回は、小さなクラスシリーズの一環として、ノーツが起動しているかどうか判定するクラスを作ってみた。需要があるのかどうかは分かりませんがｗ

クラスモジュールを挿入して、オブジェクト名を「NotesStartedChecker」とした。英語がおかしい気もするけど。

クラスモジュールに書いたコードは次の通り。

Option Explicit

'フィールド
Private isStarted_ As Boolean

'アクセサ
Public Property Get isStarted() As Boolean                '……(1)
  isStarted = isStarted_
End Property

'コンストラクタ
Private Sub Class_Initialize()                            '……(2)
  isStarted_ = False
End Sub

'メソッド
Public Sub checkNotesIsStarted(ByVal alertMessage As String)
  Dim objWord As Object                                   '……(3)
  Set objWord = CreateObject("Word.Application")          '……(4)
  If objWord.Tasks.Exists("Lotus Notes") = True Then      '……(5)
    isStarted_ = True                                     '……(6)
    '実行中タスクの中にLotus Notesがあれば、何もしない。
    objWord.Quit                                          '……(7)
    Set objWord = Nothing                                 '……(8)
  Else
    '実行中タスクの中にLotus Notesがなければ、メッセージを表示して終了
    isStarted_ = False
    MsgBox alertMessage, vbExclamation
    objWord.Quit
    Set objWord = Nothing
    Exit Sub
  End If
End Sub

例によってコードの解説。

• (1)はisStartedプロパティのgetter。Notesが起動しているかどうかを格納する。これぐらいしか持たせるプロパティが思いつかない。
• デフォルト値がFalseなので、(2)は不要だと思いますが、まあ、ないと寂しいのでｗ
• (3)でWordオブジェクト用の変数を用意する。CreateObjectを使うので、参照設定は不要。よって、不本意ながらObject型。
• (4)でWordのインスタンスを変数にセット。
• (5)がミソ。WordオブジェクトのTasksコレクションの中に、Lotus Notesが入っているかどうかをExistsメソッドで調べる。入っていたらTrueが返る。
• Tasksコレクションの中にLotus Notesが入っていたら、すなわち、Lotus Notesが起動中なら、(6)でisStarted_をTrueにする。
• Wordオブジェクトはもはや用済みなので、(7)で終了させて、
• (8)でオブジェクト変数を解放する。
• Lotus Notesが起動していない場合は、メッセージを表示する。

とまあ、こんな感じ。

標準モジュールに下記のコードを書いて実行してみよう。

Public nsc As NotesStartedChecker
Sub test02()
  Set nsc = New NotesStartedChecker
  Dim alertMessage As String
  alertMessage = "Lotus Notesは起動していません。" & vbCrLf & _
                 "    　＿＿＿＿＿＿＿＿_" & vbCrLf & _
                 "　／　　　　　　　　  ＼ " & vbCrLf & _
                 "／　／・＼　　／・＼　  　＼" & vbCrLf & _
                 "|　　￣￣　　　￣　　 　　|　ち～んｗ" & vbCrLf & _
                 "|　　　　（＿人＿）　　 　|" & vbCrLf & _
                 "|　　　　　＼ 　   |   　    　 |" & vbCrLf & _
                 "＼　　　　 　＼＿|　　   ／"
  nsc.checkNotesIsStarted alertMessage
End Sub

意味もなく、引数にやたら長い文字列を持たせたことは、許してください。

Lotus Notesは職場のPCにしか入っていないので、自宅のPCで実行すると当然こうなる。

CreateObjectの引数をメソッドの引数として渡すようにしたら、汎用性が高まるのかな。

@akashi_keirin on Twitter

小さなクラスを作る(1)～フォルダ選択機能

twitterのフォロワーさんからのアドヴァイス。

曰く、よく使う機能はクラスにしといた方がいいぜと。なるほど。今まで、よく使う処理をSubやFunctionにまとめて一つのモジュールに集めておいて、ライブラリ的に使っていたけど、結局、

どこに何を書いていたのか忘れる

というマヌケなことになっていた。

その点、クラスだとかなり擬人的なので、忘れにくいかも知れん。

で、さっそくやってみた。私の場合、ユーザーにフォルダを選ばせるという処理をよく使うので（しかも、やり方をよく忘れるｗ）、そんな役割のクラスを作ってみる。

クラスモジュールに「FoldePicker」という名前を付けて、以下のコードを書く。

Option Explicit

'フィールド
Private gotFolder_ As String
Private isCancelled_ As Boolean

'アクセサ
Public Property Get gotFolder() As String
  gotFolder = gotFolder_
End Property
Public Property Get isCancelled() As Boolean
  isCancelled = isCancelled_
End Property

'コンストラクタ

'メソッド
Public Sub showFolderPicker()
'機能：フォルダ選択ダイアログボックスを表示し、選択されたフォルダパスを
'      gotFolderプロパティにセットする。引数なし。
'　　　キャンセルされると、isCancelledプロパティをTrueにする。
  With Application.FileDialog(msoFileDialogFolderPicker)  '……(1)
    If .Show = True Then                                  '……(2)
      gotFolder_ = .SelectedItems(1)                      '……(3)
    End If
  End With
  If gotFolder_ = "" Then                                 '……(4)
    MsgBox "キャンセルされました。"
    isCancelled_ = True                                   '……(5)
  Else
    isCancelled_ = False                                  '……(6)
  End If
End Sub

こんな感じ。

Application.FileDialogオブジェクト（？）で、引数に「msoFileDialogFolderPicker」を指定しているので、フォルダ選択ダイアログオブジェクトを指すってことでしょうか。

• (1)でWithを使っているので、以下はEnd Withまでフォルダ選択ダイアログオブジェクトに対する操作。
• (2)のIf文の条件の中でShowメソッドを実行。ユーザーがダイアログで[ＯＫ]ボタンを押したら、条件成立。
  コチラによると、ファイル ダイアログ ボックスを表示して、ユーザーが [アクション] ボタン (-1) または [キャンセル] ボタン (0) を押したかどうかを示す Long を返します。との由。
  つまり、[ＯＫ]ボタンが押されたら「-1(True)」が返るということ。
• ユーザーがダイアログで[ＯＫ]を押したら、(3)でSelectedItemsプロパティ（＝選択したフォルダのフルパス）が変数gotFolder_に代入される。
  フォルダ選択ダイアログでは、複数選択ができないので、SelectedItemsのインデックスは「1」を指定する。
• (4)。キャンセルされると、gotFolder_には何も代入されていないことになる。
• (5)でisCancelled_をTrueにする。
• (6)は、gotFolder_にフォルダパスがセットされている場合なので、isCancelled_をFalseにしておく。
  一旦キャンセルした後、再度showFolderPickerメソッドを実行したら、isCancelled_がTrueのままになってしまうので。

動作確認のため、標準モジュールに以下のコードを書いて実行。

Public fdp As FolderPicker
Public Sub test()
  Set fdp = New FolderPicker                   '……(1)
  With fdp                                     '……(2)
    .showFolderPicker                         '……(3)
    If .isCancelled = True Then               '……(4)
      MsgBox "ズバリ、キャンセルしたでしょう！"
    Else
      Debug.Print "gotFolder = " & .gotFolder
      Debug.Print "Len(.gotFolder) = " & Len(.gotFolder)
      Debug.Print "InStrRev(.gotFolder, ""\"") = " & InStrRev(.gotFolder, "\")
      Debug.Print "Right(.gotFolder, Len(.gotFolder) - InStrRev(.gotFolder, ""\"")) = " & _
                  Right(.gotFolder, Len(.gotFolder) - InStrRev(.gotFolder, "\"))
      MsgBox "ズバリ、あなたが選んだフォルダは、「" & _
             Right(.gotFolder, Len(.gotFolder) - InStrRev(.gotFolder, "\")) & _
             "」フォルダでしょう！"           '……(5)
    End If
  End With
End Sub

一応説明。

• (1)でFolderPickerクラスのインスタンスを生成。
• ここからは、全てインスタンスfdpへの操作なので(2)でWithでまとめる。
• (3)で、showFolderPickerメソッドを実行。
• (4)。isCancelledプロパティがTrueだったら、メッセージを表示。
• (5)。isCancelledプロパティがTrueでなかったら、フォルダ名を表示。
  フォルダ名だけを切り出す処理はちょっとややこしいので、後で。

んで、実行。

フォルダ選択ダイアログが表示され……、

フォルダを選んで[ＯＫ]をクリックすると……、

ほれ、この通り、選んだフォルダ名が表示された。

キャンセルすると、……

キャンセルしたことがバレる仕様ｗ

ちなみに、フォルダ名だけを切り出すのはこんなカラクリ。

「フォルダ名は、フルパスのうち一番右にある「\」から右の文字列である」という考え方で切り出している。

今回の例だと、フルパスが

E:\個人用\ち～んw

の11文字。

一番右の「\」が前から7文字目。これはInStrRev関数で求めることができる。

11から7を引くと、4。よって、Right関数で右から4文字を抜き出してやると、めでたくフォルダ名「ち～んw」が得られる。

……とまあ、こんな感じでユーザーにフォルダを選択させてフォルダのフルパスを得るためのクラスを作ってみたけど、これで良いのだろうか……？

玄人の意見求む！

自作クラスのプロパティに配列をセットする

VBAを使って、ExcelからLotusNotesのメールを送るマクロ。ずいぶん前に作った素人丸出しのマクロだったから、いっそクラス・モジュールの練習も兼ねて作り直してみようと思い立った。

基本は、上の画像のようなワークシートに必要な値を入れ、Ｂ列の番号のところを選択した状態で実行するものとする。

送り手、つまりユーザの情報は、「ユーザ情報」というシートを別に作って、

こんな感じで管理しているものとする。

列数が多いので、まずは、標準モジュールの宣言セクションで、

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

列挙体で列名を定義しておく。これで、Cellsプロパティでセルを指定するのがかなり楽になる。異様に縦が長くなるのはまあ仕方がないと割り切ろう。

で、次にクラス・モジュールで、メールそのものを表すクラスを作りたい。送信先アドレスとか、メールの件名なんかは単なる文字列だから、コンストラクタで単純に代入するだけで済むが、メール本文とか、添付ファイルのフルパスなんかは、LotusNotesメール作成時の扱い（１要素づつappendTextとかaddNewLineで書き込んでいく）からして配列として持たせておきたい。また、そうしておくことで他のメーラー（Thunderbirdとか）への拡張も可能だから。

今回は、配列として持たせたい３つのプロパティについて、自身の覚書も兼ねて残しておく。

ちなみに、コチラを参考にさせていただきました。ありがとうございました。

まず、クラス・モジュールに、フィールド部分を並べる。

'クラス名は"CreatedMail"としています。
Private baseCell_ As Range
Private mailTo_ As String
Private CC_ As String
Private BCC_ As String
Private mailSubject_ As String
Private belongsTo_ As String
Private jobTitle_ As String
Private personName_ As String
Private mailBody_() As String         '……(1)
Private numOfBody_ As Integer
Private attFiles_() As String         '……(2)
Private numOfAttFiles_ As Integer
Private returnReceipt_ As String
Private senderData_(1 To 9) As String '……(3)

メールが持つ属性を列挙している。１個目の「baseCell」は、マクロ実行時にユーザが選んでいるセルを格納する。Ｂ列の番号のところを選んでマクロを実行するようにし、その列のデータに基づいてメールを作成することにする。

(1)～(3)が配列にするプロパティ。(1)と(2)は、その時々で要素数が変わるので、カッコ内は空白。(3)は要素数が決まっているのでカッコ内に「1 to 9」と記述している。

• (1)は、メール本文を格納する配列。10段落まで設定可能。
• (2)は、添付ファイルのフルパスを格納する配列。10個まで設定可能。
• (3)は、送信者、すなわちユーザのデータを格納する配列。これは、上の４つめの画像のとおり、項目が９つあるので、要素数を９に固定している。添え字部分を「(1 to 9)」と書く、というのが特徴的ですな。

重要なのはここから。

まずは、上記の３つのプロパティのみ、アクセサ部分のコードを挙げる。

'mailBodyプロパティ
Public Property Get mailBody(ByVal i As Integer) As String
  mailBody = mailBody_(i)
End Property
'attFilesプロパティ
Public Property Get attFiles(ByVal i As Integer) As String
  attFiles = attFiles_(i)
End Property
'senderDataプロパティ
Public Property Get senderData(ByVal i As Integer) As String
  senderData = senderData_(i)
End Property

どうやら、プロパティを配列にした場合、値を取得するためのProperty Getプロシージャに配列の添え字を渡して、その添え字に対応する要素がプロパティの値としてセットされる、という処理の流れになっているらしい。右辺にのみ添え字があるのも、そういうカラクリなんだろうな。プロパティの値が参照されたときだけ値をセットすりゃいいんだから、プロパティそのものが複数の値を配列として保持しておく必要はない、ということなんだろう。

今回は値の取得のみが可能なプロパティにしているので、Letの場合の書き方は割愛する。それはまた機会があれば……。

基本的に、この点にさえ気をつけていれば、クラスのプロパティを配列として扱うことはできそう。割と簡単なんだなー。

後は、クラス・モジュールのコードを全部載っけとこう。

Option Explicit
'クラスフィールド
Private baseCell_ As Range
Private mailTo_ As String
Private CC_ As String
Private BCC_ As String
Private mailSubject_ As String
Private belongsTo_ As String
Private jobTitle_ As String
Private personName_ As String
Private mailBody_() As String
Private numOfBody_ As Integer
Private attFiles_() As String
Private numOfAttFiles_ As Integer
Private returnReceipt_ As String
Private senderData_(1 To 9) As String

'アクセサ
Public Property Get baseCell() As Range
  Set baseCell = baseCell_
End Property
Public Property Get mailTo() As String
  mailTo = mailTo_
End Property
Public Property Get CC() As String
  CC = CC_
End Property
Public Property Get BCC() As String
  BCC = BCC_
End Property
Public Property Get mailSubj() As String
  mailSubj = mailSubj_
End Property
Public Property Get belongsTo() As String
  belongsTo = belongsTo_
End Property
Public Property Get jobTitle() As String
  jobTitle = jobTitle_
End Property
Public Property Get mailSubject() As String
  mailSubject = mailSubject_
End Property
Public Property Get personName() As String
  personName = personName_
End Property
Public Property Get mailBody(ByVal i As Integer) As String
  mailBody = mailBody_(i)
End Property
Public Property Get numOfBody() As Integer
  numOfBody = numOfBody_
End Property
Public Property Get attFiles(ByVal i As Integer) As String
  attFiles = attFiles_(i)
End Property
Public Property Get numOfAttFiles() As Integer
  numOfAttFiles = numOfAttFiles_
End Property
Public Property Get returnReceipt() As String             '……(※)
  returnReceipt = returnReceipt_
End Property
Public Property Get senderData(ByVal i As Integer) As String
  senderData = senderData_(i)
End Property

'コンストラクタ
Private Sub Class_Initialize()
  Set baseCell_ = ActiveCell                              '……(1)
  Dim n As Integer  'カウント用変数
  Dim baseRow As Long
  baseRow = baseCell_.Row
  With baseCell_.Parent
    '送信相手の基本情報を各プロパティにセット             '……(2)
    mailTo_ = .Cells(baseRow, colNum.mailTo).Value
    CC_ = .Cells(baseRow, colNum.CC).Value
    BCC_ = .Cells(baseRow, colNum.BCC).Value
    mailSubject_ = .Cells(baseRow, colNum.mailSubj).Value
    belongsTo_ = .Cells(baseRow, colNum.belongsTo).Value
    jobTitle_ = .Cells(baseRow, colNum.jobTitle).Value
    personName_ = .Cells(baseRow, colNum.personName).Value
    returnReceipt_ = .Cells(baseRow, colNum.returnReceipt).Value
    Dim i As Integer
    n = 0
    '文字列の入っている段落を数えてnumOfBodyプロパティにセット  '……(3)
    For i = colNum.p01 To colNum.p10
      If .Cells(baseRow, i).Value = "" Then                     '……(4)
        Exit For                                                '……(5)
      Else
        n = n + 1                                               '……(6)
      End If
    Next
    numOfBody_ = n                                              '……(7)
    'mailBodyプロパティに本文をセット
    ReDim mailBody_(numOfBody_)                                 '……(8)
    For i = 1 To numOfBody_                                     '……(9)
      mailBody_(i) = .Cells(baseRow, colNum.p01 + i - 1).Value
    Next
    n = 0
    '添付ファイル名の入っているセルを数えてnumOfAttFilesプロパティにセット  '……(10)
    For i = colNum.att01 To colNum.att10
      If .Cells(baseRow, i).Value = "" Then
        Exit For
      Else
        n = n + 1
      End If
    Next
    numOfAttFiles_ = n
    ReDim attFiles_(numOfAttFiles_)
    For i = 1 To numOfAttFiles_
      attFiles_(i) = .Cells(baseRow, colNum.att01 + i - 1).Value
    Next
  End With
  'ユーザ情報をsenderDataプロパティにセット                                 '……(11)
  For i = 1 To 9
    senderData_(i) = ThisWorkbook.Worksheets("ユーザ情報").Cells(i, 2).Value
  Next
End Sub

一応、コードの解説。

• (1)で、基準となるセルをプロパティにセット。以後、「インスタンス.baseCell」で取得できる。
• (2)は、単純に代入するだけのプロパティ群。これは説明不要だと思う。
  ※returnReceiptプロパティがString型なのに注意。後で説明する。
• (3)では、「本文（１行目）」～「本文（10行目）」のセル（Ｋ～Ｔ列）のうちいくつのセルに文字列が入っているのかをカウントしている。
• Forループで本文の入っているセルを左から調べていく。(4)の条件は、「セルが空白ならば」。
• (4)の条件を満たしていれば、すなわち、空白セルに当たったら、(5)でループを抜ける。
• (4)の条件を満たしていなければ、変数nをインクリメントしてループ。
• (7)まで来たら、変数nには文字列の入ったセルの数が格納されているはずなので、numOfBodyプロパティに値をセットする。
• これでmailBodyプロパティの要素数が確定しているので、(8)でReDimする。
• (9)で、Forループを用いて配列に要素を格納していく。
• (10)では、mailBodyプロパティと同様にattFilesプロパティをセットしていく。
• (11)で、同じようにsenderDataプロパティもセットする。

とりあえずこれで、コンストラクタまではできあがったことになる。

ひとまず挙動を確かめるために次のコードを標準モジュールに書く。

Public cm As CreatedMail
Sub test()
  Set cm = New CreatedMail        '……(1)
  Dim i As Integer
  For i = 1 To cm.numOfBody
    Debug.Print cm.mailBody(i)    '……(2)
  Next
End Sub

コードの説明。

• (1)でCreateMailクラスのインスタンスを生成。
• (2)では、Debug.Printを使って、Forループで

実行結果は、

ほれ、この通り。mailBodyプロパティに格納した各要素が全部順番にイミディエイト・ウィンドウに表示されている。

とりあえず、これでメールを作るための材料はひととおりクラスに持たせることができた。

後は、LotusNotesなり、Thunderbirdなり、メーラーに合わせてメールを作成するメソッドやクラスを書いていったらいいと思う。

あ、そうそう。リスト中の(※)のところ、returnReceiptプロパティをString型にしているのにはわけがあるのです。

コチラに「受信者が文書を開いたときに開封確認を送る場合は 1 を使用します。」だなんて書いてあるもんだから、てっきり

wkNDoc.ReturnReceipt = 1

と書いたら「受信確認あり」になると思うじゃないですか！

ところが、このように書くと、「送信オプション」の「受信確認」欄に不自然に「1」が埋まっているだけで、「受信確認あり」になってくれなかったんです。あまりにも謎現象だったので、しばらく放置していたのですが、

まさか、「1」とか「0」とかって、文字列じゃないよね？

と実験してみたらアンタ、

アッサリできちまった

じゃねーの!!!!!!!!

もし、同じ悩みを抱えている人がいたら、参考にしてください。

VBAで、ExcelからLotusNotesのメールを自動作成する

LotusNotesで送るメールの自動作成

メール作成・送信を自動化するマクロ

職場では、IBMのLotusNotesというグループウェアを使っています。とはいえ、ほとんど活用されていなくて、日常的にはせいぜいメールの送受信ぐらいにしか使われていない。私も、なんとなく非常に高機能なものなんだろうなあとは思いつつ、ほとんど活用していないｗ

ほとんど単なるメーラーと化しているNotes。全く同じメールを一斉送信するだけならいいんだけど、あっちこっちにちょっとづつ文面や添付ファイルが異なるメールを送らなきゃならん、ということになると非常にメンドクサイ。

「新規文書としてコピー」だかなんだかの機能（すまん、職場にしかNotesがないから確認できん）を使って一部を変えては送信、というやり方も２通や３通ならポチポチできようが、20通とか50通とか100通とかになってくると、もはや拷問のような業務になるし、添付ファイルの取り違えや宛先（メールアドレス）と本文内の宛名が一致しない、なんていうミスも起こりやすくなる。

ただでさえ砂を噛むような苦痛でしかない業務なのに、その上ミスが出て謝りまくるというのはあまりにも精神衛生上よろしくない。

なんとかならないものなのか、とggりまくって見つけたのがコチラのページ。

コードを引用する。割とあちこちで引用（っていうか転載？）されているので、「VBA　ノーツ　メール」とかでggったら、一番よくヒットするコードかも知れない。

'「Notesでメールを送信する」
'Excel97でNotes4.6用に作ったものだが、多分 どのバージョンでも動くと思います。

Const EMBED_ATTACHMENT As Integer = 1454                             '……(1)

Public Sub SendNotesMail()
    Dim wkNSes As Object    ' lotus.NOTESSESSION                     '……(2)
    Dim wkNDB As Object     ' lotus.NOTESDATABASE                    '……(3)
    Dim wkNDoc As Object    ' lotus.NOTESDOCUMENT                    '……(4)
    Dim wkNRtItem As Object ' lotus.NOTESRICHTEXTITEM                '……(5)
    Dim wkNAtt As Object    ' lotus.NOTESEMBEDDEDOBJECT              '……(6)
    Dim AttFName As String  ' 添付ファイル名(フルパス)

    ' Notesのセッションを起動する                                    '……(7)
    Set wkNSes = CreateObject("Notes.NotesSession") 
    ' NotesDatabaseオブジェクトを作成し、そのデータベースを開く      '……(8)
    Set wkNDB = wkNSes.GETDATABASE("", "")  
    ' NotesDBをユーザーのメールDBに割り当てた後に開く                '……(9)
    wkNDB.OpenMail

    ' NotesDBに文書を作成し、新規文書をオブジェクト変数にセットする  '……(10)
    Set wkNDoc = wkNDB.CREATEDOCUMENT()
    ' 件名をセットする                                               '……(11)
    wkNDoc.Subject = "テスト(タイトル)"
    ' 宛先をセットする
    wkNDoc.SendTo = Array("belie.kondo@mbh.nifty.com")
    'wkNDoc.CopyTo = Array("xxx@xxx")
    'wkNDoc.blindCopyTo = Array("xxx@xxx")

    ' 文書にリッチテキストアイテムを作成する
    Set wkNRtItem = wkNDoc.CreateRichTextItem("BODY")                '……(12)
    ' 本文をセットする
    With wkNRtItem
        .APPENDTEXT "本文（１行目）"                                 '……(13)
        .ADDNEWLINE 1                                                '……(14)
        .APPENDTEXT "本文（２行目）"                                 
        .ADDNEWLINE 2
        ' 添付ファイル名をセットする
        AttFName = "D:\TEST\Book1.xls"
        ' ファイルを添付する
        Set wkNAtt = .EmbedObject(EMBED_ATTACHMENT ,"" ,AttFName)    '……(15)
        .ADDTAB 1
        .ADDNEWLINE 1
    End With

    ' メールを送信する
    wkNDoc.Send False                                                '……(16)

    ' オブジェクト変数を解放する
    Set wkNAtt = Nothing
    Set wkNRtItem = Nothing
    Set wkNDoc = Nothing
    Set wkNDB = Nothing
    Set wkNSes = Nothing

    MsgBox "メール発信", vbOKOnly + vbInformation
End Sub

'Notesが起動していることが前提。

これを使い始めたきっかけは、

150件以上の宛先に、それぞれ全て異なる添付ファイルを添付してメールを送る

という、アホとしか思えない業務があったからだった。

聞けば、これまでの担当者は、それを休日に職場に出て行って、半日がかりでやっていたらしい。

私は、「バカヤロウ、そんなことができるか！　第一、休日の間に送ったメールでミスがあったら、週明けは苦情電話祭りになるじゃんか……」と思ったので、必死でそんなアホなことに陥らないようにggりまくりましたよ。良かった、インターネッツのある時代で。

まあ、そんなわけで、上掲のコードには非常にお世話になりましたよ。150件超のそれぞれ添付ファイルの異なるメールを、ちゃーんと本文内の宛名もその人に合わせて、10分ほどで送信完了できたわけですからね。

当時は、コードの意味なんてほとんど分からないまま使っていましたが、少しは分かるようになってきているので、確認も兼ねて説明してみよう。所詮素人のやることなので、間違えていたら優しく教えてください。

• (1)は、後の(15)、EmbedObject関数（？）の引数にするための定数。
• (2)～(6)では、VBAでNotesの各オブジェクトを操作するために、Notesの各オブジェクトを格納する変数を宣言している。
• (2)は、Notesのセッションそのもの。……と書いている自分でもいまいち意味がよく分かっていないｗ
• (3)は、Notesのデータベース。
• (4)は、Notesのドキュメント。たぶん、メール全体を指すのだと思う。
• (5)は、Notesのリッチテキストアイテム。たぶん、メールの中の、本文をはじめとする「目に見えている部分」を表しているのだと思う。
• (6)は、Notesの埋め込みオブジェクト。たぶん、添付ファイルなどの、メールに埋め込まれるものを表しているのだと思う。

たかがメール１本に、これだけたくさんのオブジェクトが関わっとるんですなあ。

• (7)では、VBAのCreateObject関数を用いて"Notes.NotesSession"クラスのインスタンスを生成して変数にセットしている。以後、この変数を使ってNotesのセッションを操作できるということ。以下同じ。
• (8)では、(7)でインスタンス化したNotesSessionクラスのgetDatabaseメソッドを使ってNotesDatabaseクラスのインスタンスを生成し、変数にセットしている。
• (9)では、(8)でインスタンス化したNotesDatabaseクラスのopenMailメソッドを用いて……何してるんだろ？？？
• (10)では、(8)でインスタンス化したNotesDatabaseクラスのcreateDocumentメソッドを用いてNotesDocumentクラスのインスタンスを生成し、変数にせっとしている。
• (11)以下のところでは、(10)でインスタンス化したNotesDocumentクラスのそれぞれのフィールドに値をセットしている。これはまあ、見たらだいたい初心者でも何やってるかは分かると思う。
• (12)では、NotesDocumentクラスのcreateRichTextItemメソッドを用いて、NotesRichTextItemクラスのインスタンスを生成し、変数にセットしている。

さあ、いよいよここからがメール本体の部分だ。

• (13)は、NotesRichTextItemクラスのappendTextメソッド。引数に指定したテキストを本文に追加する。
• (14)は、NotesRichTextItemクラスのaddNewLineメソッド。引数で指定した行数の新しい行を追加する。
• (15)は、NotesRichTextItemクラスのembedObjectメソッドを用いて添付ファイルをNotesEmbededObjectクラスのインスタンスとして生成しているのだと思う。そうした上で変数にセットしているのだろう。
• (16)でメールを送信。

あとは、オブジェクト変数を解放し、メッセージを表示しておしまい、ということ。

このコードには本当に非常にお世話になった。このコードのおかげで何度救われたことか……。

ただ、二つかなり困ることがあった。

• メールがいきなり送られてしまうこと。
• 送信履歴が残らないこと。

特に、２点目は困る。仕方がないので、常に自分自身にBCCで送るようにして擬似的に送信履歴が残るようにしていた。ただ、このやり方だと、受信リスト上で選ぶたびに「このメールには非表示の写しが」でんでんうんぬんといちいち出てきてうっとうしいことこの上ない。

それでも辛抱して使い続けていたある日、コチラのページに出会ったのでした。

メールを自動作成し、送信直前の状態で表示するマクロ

ソースコードも引用しておきます。

'*********************************************************************************
'いきなり送りつけずに、編集状態にする様に改造
'一旦確認してから送ると、送信ボックスに残るメリットあり。
'*********************************************************************************

Public Sub makeNotesMail()
    Dim wkNSes As Object    ' lotus.NOTESSESSION
    Dim wkNDB As Object     ' lotus.NOTESDATABASE
    Dim wkNDoc As Object    ' lotus.NOTESDOCUMENT
    Dim wkNRtItem As Object ' lotus.NOTESRICHTEXTITEM
    Dim wkNAtt As Object    ' lotus.NOTESEMBEDDEDOBJECT
    Dim AttFName As String  ' 添付ファイル名(フルパス)
    '追加
    Dim ws As Object 'NotesUIWorkspace
    Dim uidoc As Object
    
    ' Notesのセッションを起動する
    Set wkNSes = CreateObject("Notes.NotesSession")
    '追加
    Set ws = CreateObject("Notes.NotesUIWorkspace")
    
    ' NotesDatabaseオブジェクトを作成し、そのデータベースを開く
    Set wkNDB = wkNSes.GETDATABASE("", "")
    ' NotesDBをユーザーのメールDBに割り当てた後に開く
    wkNDB.OpenMail

    ' NotesDBに文書を作成し、新規文書をオブジェクト変数にセットする
    Set wkNDoc = wkNDB.CREATEDOCUMENT()
    ' 件名をセットする
    wkNDoc.Subject = "テスト(タイトル)"
    ' 宛先をセットする
    wkNDoc.SendTo = Array("abc@def.ghi.com")
    'wkNDoc.CopyTo = Array("xxx@xxx")
    'wkNDoc.blindCopyTo = Array("xxx@xxx")

    ' 文書にリッチテキストアイテムを作成する
    Set wkNRtItem = wkNDoc.CreateRichTextItem("BODY")
    ' 本文をセットする
    ' VBAでやる場合は、普通に文字列bufとかに、vbCrLfを介して文字を入れてやって
    ' wkNRtItem.APPENDTEXT buf で一丁上がり
    
    With wkNRtItem
        .APPENDTEXT "本文（１行目）"
        .ADDNEWLINE 1
        .APPENDTEXT "本文（２行目）"
        .ADDNEWLINE 2
        ' 添付ファイル名をセットする
        AttFName = getDesktopPath & "\Book1.xlsx"
        ' ファイルを添付する
        Set wkNAtt = .EmbedObject(EMBED_ATTACHMENT, "", AttFName)
        .ADDTAB 1
        .ADDNEWLINE 1
    End With
    ' メールを保存する。これをやらないとRichItemの編集が表示されない  '……(*)
    wkNDoc.Save False, False
    ' メールを編集状態にする
    Set uidoc = ws.EDITDOCUMENT(True, wkNDoc, False)

    ' オブジェクト変数を解放する
    Set wkNAtt = Nothing
    Set wkNRtItem = Nothing
    Set wkNDoc = Nothing
    Set uidoc = Nothing
    Set wkNDB = Nothing
    Set wkNSes = Nothing
    Set ws = Nothing

End Sub

ポイントは(*)のところ。何と、たったこれだけで、送信直前の状態で画面表示されます。

しかも、Notesの側で送信アイコンをクリックして送信するので、ちゃんと送信履歴に残るし、(*)の時点でドラフトに保存されているから、送信せずに閉じてもちゃんと残っている。

これは素晴らしい!!!!!!!!!!!

……というわけで、私は、上記２つのコードを参考に、

Excelでご覧のようなシートを作成し、メールを自動作成するマクロを作って大いに活用しています。

そのマクロは、また折を見てご紹介します。今日はもうここまででかなり長くなってしまったので……。

コチラもどうぞ！

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

年度初日直近の月曜日を割り出すマクロ

ちょい書きマクロです。

年度初日（４月１日）が属する週の月曜日の日付を割り出す必要があって、ちょこちょこっと作ってみた。

ワークシートはこんな感じ。

Ａ３セルにはご覧の通りの書式設定を施しておく、と。

Ａ１セルに、西暦年数を入れたら、Ａ３セルにその年度の４月１日が属する週の月曜日の日付が表示される、という風にしたい。

Ａ１セルの値の変化に連動してマクロが起動すれば良いのだから、VBAのコードはSheet1のモジュールに記述することになる。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim tmpDate As Date
  With Target
    If .Row = 1 And .Column = 1 Then      '……(1)
      Application.EnableEvents = False    '……(2)
      If IsNumeric(.Value) = False Then   '……(3)
        MsgBox "西暦年数を４けたの数字で入れよ。"
        .Value = Year(Now())              '……(4)
        Application.EnableEvents = True   '……(5)
        Exit Sub
      ElseIf .Value < 1900 Or .Value > 2200 Then  '……(6)
        MsgBox "現実的な西暦年数を入れよ。"
        .Value = Year(Now())
        Application.EnableEvents = True
        Exit Sub
      Else      '……(7)
        tmpDate = DateSerial(.Value, 4, 1)    '……(8)
        tmpDate = searchMonday(tmpDate)       '……(9)
        ThisWorkbook.Worksheets("Sheet1").Range("A3").Value = tmpDate '……(10)
        Application.EnableEvents = True
      End If
    End If
  End With
End Sub

上記リストの(9)のところで、「searchMonday」というFunctionプロシージャを呼び出しているが、そのリストは後で。

Sheet1モジュールのWorksheet_Changeプロシージャにコードを書いていく。Worksheetオブジェクトの「Change」というイベントをきっかけに駆動するプロシージャだと理解しておけば良い。「Change」は「セルの値が変わった」というイベントのこと。以下、コードの説明。

• (1)で、Targetの行番号が１、かつ列番号が１、すなわち値が変わったセルがＡ１セルだったら、という条件を指定し、
• (1)の条件に当てはまっていたら、(2)で一旦イベントの発生を止めている。
  ※一旦Application.EnableEventsをFalseにすると、Trueにするまでの間、
  仮にイベントが発生しても無視される。
• (3)では、Ａ１セルに入力された値が数値かどうかを判定している。数値でなかったら、メッセージを表示し、
• (4)で現在の西暦年数をＡ１セルにセット。
• (5)でApplication.EnableEventsをTrueに戻している。
• Ａ１セルの値が数値だったら、(6)に来る。ここではＡ１セルの値が1901～2199の間に収まっているかどうかを判定している。
  ※ここの数字の範囲は、必要に応じて現実的なものにしたら良い。
• Ａ１セルの値が範囲内に収まっていなければ、やはりメッセージを表示して現在の年数を入れる。ここでもApplication.EnableEventsをTrueにするのを忘れないように。
• 上記２つの条件をかいくぐってきたら、(7)に来る。
• (8)で変数tmpDateにＡ１セルに入力した年の４月１日のシリアル値を代入。
• (9)は後述のFunctionプロシージャ。４月１日直前の月曜日のシリアル値を返す。
• (10)でＡ３セルに(9)で取得した日付のシリアル値を記入。
• もちろん、最後にApplication.EnableEventsをTrueにするのを忘れないように。

とまあ、こんな感じ。

で、肝腎の４月１日直前の日付を求めるロジックはコチラ。

Private Function searchMonday(ByVal tmpDate_ As Date) As Date
  Do While Weekday(tmpDate_) <> vbMonday    '……(1)
    tmpDate_ = tmpDate_ - 1                 '……(2)
  Loop
  searchMonday = tmpDate_                   '……(3)
End Function

• (1)で、Weekday関数の戻り値がVbMondayでなければ繰り返す、と繰り返し条件を設定。
  ※もちろん、引数として渡した日付の曜日が月曜日だったら、中身を一度も実行せずにループを抜けることになる。
• (2)で、日付のシリアル値から１を引く。すなわち、１日前の日付にする。
• 日付の曜日が月曜日になった時点でループを抜け、(3)でその日付をsearchMondayの戻り値として元のプロシージャに返す。
  ※ここでは、上のリストの(9)で変数tmpDateに日付を代入することになる。

Ａ１セルに「2014」と入力すると、

ほれ、この通り。

「2017」と入力すると、

ほれ、この通り。

こういう、ちょっとしたマクロを作るのも楽しいね。

クラス・モジュールの邪道かも知れない使い方

シートがたくさんあるブックをVBAで操作するとき、いつもシートの指定がめんどくさいなあと思っていました。

まあ、ちょい書きのマクロだったらシートの指定なんか雑でもいいんですけど、そこそこの規模のものになると、厳密に指定しておかないと後でわけが分からなくなりますからね。

毎回毎回

Thisworkbook.Worksheets("HogeHogeHoge")

とか、いちいち書いてられっかっての。

……というわけで、

クラス・モジュール使えばいいんじゃね？

とか思いついたわけですよ。

たとえば、こんなブックがあったとする。シート名は通常分かりやすさを優先してこんな風に日本語で付けることが多いと思うが、これだとコード上でシートを指定するときに、いちいち全角／半角を切り替えるという面倒が生ずる。１回や２回なら何とも思わないが、度重なるとうっとうしいことこの上ない。

Public Const SCHEDULE_MASTER As String = "予定マスタ"
Public Const EXTRACT_DATA As String = "予定抽出"
Public Const PLACE_DATA_MASTER As String = "場所マスタ"
Public Const PERSON_DATA_MASTER As String = "人物マスタ"
Public Const DATE_DATA_MANAGER As String = "日付データ管理"
Public Const DAILY_SCHEDULE As String = "一日の予定"
Public Const WEEKLY_SCHEDULE As String = "週間予定"
Public Const EIGHT_WEEKS As String = "８週間予定"
Public Const UNWRITTEN_CONTENTS As String = "未転記"

まず、シート名は定数に放り込んである。標準モジュールの宣言セクションに書いている。まあ、これは不要だったかも知れない。

んで、クラス・モジュールに次のコードを書く。
※オブジェクト名は「TargetSheets」にしています。

Option Explicit
'クラスフィールド……(1)
Private scheduleMaster_ As Worksheet
Private extractSchedule_ As Worksheet
Private placeMaster_ As Worksheet
Private personMaster_ As Worksheet
Private dateManager_ As Worksheet
Private dailySchedule_ As Worksheet
Private weeklySchedule_ As Worksheet
Private eightWeeks_ As Worksheet
Private unwrittenContents_ As Worksheet

'アクセサ……(2)
Public Property Get scheduleMaster() As Worksheet
    Set scheduleMaster = scheduleMaster_
End Property
Public Property Get extractSchedule() As Worksheet
    Set extractSchedule = extractSchedule_
End Property
Public Property Get placeMaster() As Worksheet
    Set placeMaster = placeMaster_
End Property
Public Property Get personMaster() As Worksheet
    Set personMaster = personMaster_
End Property
Public Property Get dateManager() As Worksheet
    Set dateManager = dateManager_
End Property
Public Property Get dailySchedule() As Worksheet
    Set dailySchedule = dailySchedule_
End Property
Public Property Get weeklySchedule() As Worksheet
    Set weeklySchedule = weeklySchedule_
End Property
Public Property Get eightWeeks() As Worksheet
    Set eightWeeks = eightWeeks_
End Property
Public Property Get unwrittenContents() As Worksheet
    Set unwrittenContents = unwrittenContents_
End Property
'コンストラクタ……(3)
Private Sub Class_Initialize()
    Set scheduleMaster_ = ThisWorkbook.Worksheets(SCHEDULE_MASTER)
    Set extractSchedule_ = ThisWorkbook.Worksheets(EXTRACT_DATA)
    Set placeMaster_ = ThisWorkbook.Worksheets(PLACE_DATA_MASTER)
    Set personMaster_ = ThisWorkbook.Worksheets(PERSON_DATA_MASTER)
    Set dateManager_ = ThisWorkbook.Worksheets(DATE_DATA_MANAGER)
    Set dailySchedule_ = ThisWorkbook.Worksheets(DAILY_SCHEDULE)
    Set weeklySchedule_ = ThisWorkbook.Worksheets(WEEKLY_SCHEDULE)
    Set eightWeeks_ = ThisWorkbook.Worksheets(EIGHT_WEEKS)
    Set unwrittenContents_ = ThisWorkbook.Worksheets(UNWRITTEN_CONTENTS)
End Sub

初心者の私には、VBAのクラス・モジュールのコンストラクタって何の役にたつのかもう一つよく分からない。何で引数を持たせられない仕様なんでしょうねえ？？？

ま、それはさておき、今回の例の場合は珍しくコンストラクタが使える。なんせ、ThisWorkbookのそれぞれのシートを格納することははじめから分かっとるわけだから。

「クラス・モジュールって何？？？」な人には、いきなり見たこともないようなコードが大量に並んでいるのを見て軽く引いたかも知れないが、よく見たら同じようなコードが並んでいるだけだということに気づくと思う。コードの説明は後にして、とりあえずここまで下ごしらえをしておけば、標準モジュールの宣言セクションに

Public ts As TargetSheets

と書いてTargetSheets型のクラス変数をPublicで用意して、

任意のプロシージャ内で

Set ts = New TargetSheets

としてやれば、TargetSheetsクラスのインスタンスが生成されて、以後変数tsをTagetSheetsクラスのインスタンスとして使用できる。

……と言っても「クラス・モジュールって何？？？」な人にはピンと来ないでしょうね。

短く言えば、変数「ts」がプロパティとしてこの例の場合だと８つのシートを持っているかのように扱えるということ。

その辺は、実際試してもらったらすぐに分かると思う。それより何より、とにかく便利なのは、

こんな風にインテリセンスが働くこと！

クラス・モジュールのコードを書くときに、リスト中の(1)、(2)のところで分かりやすいプロパティ名にしておけば、シートの指定がめちゃくちゃ楽になるんですわ。

たとえば、普通だったら、

このブックの「予定マスタ」シートのＡ１セルを選択したい！

ってときには、

ThisWorkbook.Worksheets("予定マスタ").Range("A1").Select

とコーディングしていたのが、TagetSheetsクラスのインスタンスを生成した後だったら、

ts.scheduleMaster.Range("A1").Select

と書くだけで済む（しかも、「scheduleMaster」については、「s」を入れた時点でリスト表示されるので、実際の入力は[Tab]を押すだけ）、ということなんです。さらに、クラス変数をPublicで宣言しているので、どのモジュール・プロシージャでも使える！　ある程度以上ややこしいマクロを作るときに、これは強力。

何種類もシートがあって、操作対象を切り替える回数が多い（しかも、そのことについて「チッ、めんどくせーなー」と感じている）のなら、試してみる価値はあると思う。

ちなみに、上記のクラス・モジュールのコードですが、(1)、(2)については、コチラもどうぞ。

「scheduleMaster」プロパティを例にとると、scheduleMasterプロパティの値（「予定マスタ」シートのこと）は、Private変数「scheduleMaster_」が保持していて、外部から「scheduleMasterプロパティの値を寄こせ！」という問い合わせが来たら（＝「ts.scheduleMaster.～～」の部分が実行されたら）、(2)でProperty Getが呼び出されて、scheduleMasterプロパティにscheduleMaster_の値がセットされる、という流れ。今回の例だと、Property Letがないので、インスタンス生成時にコンストラクタでThisWorkbook.Worksheets("予定マスタ")がセットされた後はscheduleMasterプロパティが書き換えられることはない、すなわち「ts.scheduleMaster」は常に「予定マスタ」シートを指すということになる。

なんか、説明が難しくなってしまったけれど、実際に使ってみたらすぐに理解できると思う。

私も、Javaの入門書を読んでいるだけのときはクラスとインスタンスってよく分からなかったんだが、実際に自分でクラスを作ってインスタンス化してみるとたちどころに理解できたので。

さて、最後に(3)。これはいわゆる「コンストラクタ」というやつで、インスタンス生成時に実行される部分。VBAの場合、引数を渡すことができないので、いまいち使いどころがよく分からないんだが、先述のとおりこの場合は各プロパティにセットすべき値が決まっているので、ここでやってしまう。

……とまあ、素人考えでこんな風に使っているんですが、たぶん、タイトルにも書いたように邪道なんでしょうねえ。

何より、このクラスに持たせるメソッドがまるで思いつかない……。良かったら誰かアドバイスください。