メール自動作成用のクラスを作る～(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
コードの説明
例によってコードを説明していこう。基本的な部分は、このとき説明したので省略。もちろん、その当時から大して成長していないのでｗ、あのとき分からなかったことは、今以て分からないままですｗ
- (1)は、見ての通り変数の宣言。たかがメール１本作るのにこんなにたくさんのオブジェクトが絡んでるんですねえ。Thunderbirdとはえらい違いだｗ
- (2)は、コメントにもある通り「ノーツのセッション」とやらをインスタンス化している。……と書いている自分でも抽象的すぎて何のことかわからねえよ！
- (3)まで来るとやっとちょっと分かってくるぞ。NotesDocumentというものをインスタンス化しとるわけだ。
- (4)で、「NotesDocument」の諸属性をセットしている。NotesDocumentってのは、「１本のメール全体」ぐらいのイメージなんでしょうね。
- (5)では、CreateRichTextItemというメソッドを使って、RichTextItemってのをインスタンス化している。先のNotesDocumentオブジェクトの中にRichTextItemオブジェクトがある、というイメージなんでしょうね。
- (6)では、RichTextStyleってのをインスタンス化している。NotesSessionクラスのメソッドを使っているところを見ると、NotesSessionオブジェクトの中にRichTextStyleオブジェクトがある、というイメージなんでしょうね。
- (7)では、RichTextStyleのFontSizeというフィールドに値を設定して、フォントサイズを決めている。RichTextItemとRichTextStyleってのはHTMLとCSSみたいな関係なんですかね。
- (8)からはいよいよRichTextItemの作成。
- (9)では、AppendStyleメソッドでRichTextStyleで設定したスタイルを適用している。
- (10)からは、まず宛名部分を作っている。とても原始的なやり方ですｗ AppendTextメソッドで文字列を追加して、AddNewLineで行を追加していく、というのが基本みたい。
- (11)では本文を追加している。他のパーツと違って、本文は配列で持たせているので、このようにForループで追加している。
- (12)からは、本文以外の部分（添付ファイルと署名）なので、フォントサイズを下げている。
- (13)は、添付ファイルの埋め込み。添付ファイルのフルパスを配列で持たせているので、これまたForループでおｋ。
RichTextItemクラスのメソッドでインスタンス化されているところからすると、添付ファイルは、RichTextItemオブジェクトの配下のEmbeddedObject（埋め込まれたオブジェクト）というオブジェクトとして管理されているんですねえ。 - (14)以下のところで署名部分を作っている……んですけど、なんか、あまりにも原始的ですよねえ……。
手動でメールを作るときには、HTMLで作った署名が自動で挿入されるんですから、そういうやり方があるはずなんですけど、未だによく分かりません。雰囲気からして署名なんかもEmbeddedObjectっぽんですけどねえ……。知っている人がいたら教えてください。
メソッド呼び出しのコード
２段階で呼び出すことにする。つまり、
- LotusNotesが起動しているかどうかチェック
- 起動していたら、引数を渡してメインメソッドを呼び出す
てな感じ。
第１段階のコード
Sub callLotusNotes()
Set nsc = New NotesStartedChecker '……(1)
With nsc
.checkNotesIsStarted _
"ちょｗｗｗ おまｗｗｗ" & vbCrLf & _
"LotusNotesが起動してないしｗｗｗ" & vbCrLf & _
"LotusNotesを起動・ログインして出直してこいやｗｗｗ" & vbCrLf & _
" ＿＿＿＿＿＿＿＿_" & vbCrLf & _
" ／ ＼ " & vbCrLf & _
"／ ／・＼ ／・＼ ＼" & vbCrLf & _
"| ￣￣ ￣ | ち～んｗ" & 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メソッドを呼び出す、という仕掛け。
第２段階のコード（再掲）
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コードの説明
再掲ゆえ省略。前回を参考にしてください。
おわりに
ノーツは職場のＰＣにしかないので、ちゃんと動くのかどうかは分かりません。 今回、コードの説明を書いてみて、ちょっとづつ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_ & " 様"
'左肩部分の下に２行文空行をセット
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)以下の８行がそうなんですけど、行継続文字でつないでいるので、実際は１行です。
実行準備
後々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 _
"ちょｗｗｗ おまｗｗｗ" & vbCrLf & _
"LotusNotesが起動してないしｗｗｗ" & vbCrLf & _
"LotusNotesを起動・ログインして出直してこいやｗｗｗ" & vbCrLf & _
" ＿＿＿＿＿＿＿＿_" & vbCrLf & _
" ／ ＼ " & vbCrLf & _
"／ ／・＼ ／・＼ ＼" & vbCrLf & _
"| ￣￣ ￣ | ち～んｗ" & 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から。
ウチのＰＣにはノーツが入っていないので当然こうなるｗ
んで、Thunderbird。
添付ファイルだって、
こんな風に準備して、
こんな風に入力しておくと、
ほれ、この通り、バッチリ添付されとる。
んで、上の画像だと、本文の上にミョーな空白ができるんですが、コチラによると、アカウントの設定で解消できる、とのこと。
Thunderbirdの「ツール」メニューから、
「アカウント設定」を選択し、
「編集とアドレス選択」に進み、
「HTML形式でメッセージを編集する」のチェックを外して実行すると、
ほれ、この通りミョーな空白はなくなっておる。
おわり
ちゃっちゃと書くつもりがまたしても異様に長くなってしまった。
LotusNotes版も一応できているので、近いうちにうｐします。
メール自動作成用のクラスを作る～(2)
先に断っときます。今回はカンバンに偽りあり。
「……クラスを作る」とか題名で言ってますが、クラスは作りません。ただ、前回作ったクラスを活用するためのコードを作るんだから、あながち嘘でもない。そんなわけで、そこんとこヨロシク。
前回作ったクラス「MailData」では、メール作成に必要なデータを４つに分けて取得するようにしていた。すなわち、
- メールの基礎データ
- メール本文の配列
- 添付ファイルのフルパスの配列
- 送信者データの配列
の４つだ。
……てことは、まずはこれらのデータをワークシートから取得する処理を書かねばならん、ということだ。
諸データ取得メソッドを作る
基礎データ取得メソッド
基礎データを、構造体の形でまとめる処理を書く。このメソッドは、他には使い道がないと思うので、Privateで呼び出され専用にする。他の３つも同じ。
Private Sub setMailBasicData(ByRef baseCell_ As Range)
Dim baseRow_ As Integer
baseRow_ = baseCell_.Row '……(1)
With baseCell_.Parent '……(2)
'送信相手の基本情報を構造体の各要素にセット
mldt.mailTo = .Cells(baseRow_, colNum.mailTo).Value '……(3)
mldt.CC = .Cells(baseRow_, colNum.CC).Value
mldt.BCC = .Cells(baseRow_, colNum.BCC).Value
mldt.mailSubject = .Cells(baseRow_, colNum.mailSubj).Value
mldt.belongsTo = .Cells(baseRow_, colNum.belongsTo).Value
mldt.jobTitle = .Cells(baseRow_, colNum.jobTitle).Value
mldt.personName = .Cells(baseRow_, colNum.personName).Value
mldt.returnReceipt = .Cells(baseRow_, colNum.returnReceipt).Value
End With
End Sub今回のマクロは、メール作成用のデータが「１件につき１行」という形になっていて、「対象データの行のＢ列を選択した状態でマクロを実行する」というやり方にしている。従って、データを拾い出すときの基準として選択中のセルを渡すことになる。引数の「baseCell_」というのはそういうことです。
さて、コードの解説。
- ワークシートで選択中のセルの行が、各種データを集める際の基準になるので、(1)で引数として渡されたセルの行番号を変数「baseRow_」に格納している。
- (2)で、引数として渡されたセルのParentプロパティを取得している。要するにメール作成用データが入力されたシート（「Main」ワークシート）のこと。以下、「End With」まで、「Main」ワークシートに対する操作。
- (3)からの８行で、構造体「mldt」の各要素にデータを持たせている。
「Main」ワークシートの列の指定には列挙体を使っているので、何の列を指しているのか分かりやすいと思う。
メール本文の配列取得メソッド
Private Sub setMailBody(ByRef baseCell_ As Range, _
ByVal n As Integer)
'※引数「n」は、本文が入力されているセルの数
Dim baseRow_ As Integer
baseRow_ = baseCell_.Row
ReDim mlBody(n) '……(1)
Dim i As Integer
With baseCell_.Parent
For i = 1 To n
mlBody(i) = .Cells(baseRow_, colNum.p01 + i - 1).Value '……(2)
Next
End With
End Subこのメソッドには、引数として基準セルと本文データの入っているセルの数を渡す。
- 配列の要素数「n」でmlBody()をReDimする。
- あとは、Forループを使ってmlBody()の各要素にデータを放り込んでいるだけ。Cellsプロパティの列インデックスが、カウンタ変数「i」がインクリメントするごとに「0,1,2,……」とインクリメントするので、右へ右へと値を取得して配列にセットしていく感じになる。
添付ファイルフルパスの配列取得メソッド
メール本文の取得とほぼ同じやり方なので、コードを載せるだけにする。
Private Sub setAttachmentFiles(ByRef baseCell_ As Range, _
ByVal n As Integer)
'※引数「n」は、添付ファイルのフルパスが入力されているセルの数
Dim baseRow_ As Integer
baseRow_ = baseCell_.Row
ReDim mlAttFiles(n)
Dim i As Integer
With baseCell_.Parent
For i = 1 To n
mlAttFiles(i) = .Cells(baseRow_, colNum.att01 + i - 1).Value
Next
End With
End Sub送信者データの取得メソッド
送信者のデータは、別シートで管理しているので、
あらかじめこんな風にデータ範囲に名前を付けておく。今回は「UserInformationTable」としている。
そうしたら、
Range("UserInformationTable").Rows.Countこれで送信者データが何種類あるか取得できるので。
Private Sub setSenderData(ByVal n As Integer)
'※引数「n」は、送信者データの数
ReDim mlSenderData(n)
Dim i As Integer
For i = 1 To n
mlSenderData(i) = ThisWorkbook.Worksheets("ユーザ情報").Cells(i, 2).Value
Next
End Subこれはもう説明不要だと思う。
メインメソッドを作る
上記４つのメソッドをそれぞれ呼び出してやれば、「MailData」クラスのインスタンスにデータを渡す準備は完了、ということになる。
メインメソッドのコード
Sub voidMain()
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) '……(1)
Set md = New MailData '……(2)
'MailBodyクラスのインスタンスにメールの基礎データをセット
md.getMailBasicData mldt '……(3)
With md
Debug.Print "★★★メール基礎データ★★★" '……(4)
Debug.Print .mailTo
Debug.Print .CC
Debug.Print .BCC
Debug.Print .mailSubject
Debug.Print .belongsTo
Debug.Print .jobTitle
Debug.Print .personName
Debug.Print .returnReceipt
End With
'本文文字列の入っているセルを数えて変数「n」にセット
Dim i As Integer
n = 0 '……(5)
For i = colNum.p01 To colNum.p10 '……(6)
If objSh.Cells(baseRow, i).Value = "" Then '……(7)
Exit For '……(8)
Else
n = n + 1 '……(9)
End If
Next
'本文を配列に格納する。
Call setMailBody(baseCell, n) '……(10)
'MailDataクラスのインスタンスにメール本文の配列をセット
md.getMailBodyArray mlBody() '……(11)
Debug.Print "★★★本文の配列★★★" '……(12)
For i = 1 To UBound(mlBody())
Debug.Print md.mailBody(i)
Next
'添付ファイルのフルパスが入っているセルを数えて変数「n」にセット
n = 0 '……(13)
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)
'MailDataクラスのインスタンスに添付ファイルフルパスの配列をセット
md.getMailAttFilesArray mlAttFiles()
Debug.Print "★★★添付ファイルフルパス★★★"
For i = 1 To UBound(mlAttFiles())
Debug.Print md.attFiles(i)
Next
'送信者データを配列に格納する '……(14)
Call setSenderData(Range("UserInformationTable").Rows.Count)
'MailDataクラスのインスタンスにユーザー情報の配列をセット
md.getSenderDataArray mlSenderData()
Debug.Print "★★★送信者データ★★★"
For i = 1 To UBound(mlSenderData())
Debug.Print md.senderData(i)
Next
End Sub
Private Function booleanCheckActiveCell(ByRef nowSelecting As Range) As Boolean '……(*)
With nowSelecting
If nowSelecting.Parent.Name <> MAIN_SHEET_NAME Then
MsgBox "この痴れ狗めぐぁーーーーーーッ！", vbCritical
MsgBox "そもそも「" & MAIN_SHEET_NAME & "」ワークシートを選ぶところから出直してこいや！"
Exit Function
End If
'アクティブセルの位置がおかしいときは終了。
'番号のセルを選んでいないときは、メッセージを表示して終了
If .Column <> colNum.numOf Then
MsgBox "番号のセル（Ｂ列）を選んで出直してこいや！", vbCritical
Exit Function
End If
'１行目を選んでいるときは、メッセージを表示して終了
If .Row = 1 Then
MsgBox "ぼけーーーーーー！", vbCritical
MsgBox "そこを選んでどうするねん！", vbExclamation
Exit Function
End If
'送信済みフラグがあるときは、メッセージを表示して終了
If .Cells(nowSelecting.Row, colNum.isSent).Value = "済" Then
MsgBox "二重に送ってどうするねん！", vbCritical
Exit Function
End If
'宛先がないときは、メッセージを表示して終了
If .Parent.Cells(nowSelecting.Row, colNum.mailTo).Value = "" Then
MsgBox "(ﾟДﾟ)ﾊｧ?", vbCritical
MsgBox "宛先アドレスが空欄なんやけど？", vbExclamation
Exit Function
End If
End If
End With
booleanCheckActiveCell = True
End Function
Private Sub makeUserSick() '……(**)
MsgBox " ＿＿＿＿＿＿＿＿_" & vbCrLf & _
" ／ ＼ " & vbCrLf & _
"／ ／・＼ ／・＼ ＼" & vbCrLf & _
"| ￣￣ ￣ | ち～んｗ" & vbCrLf & _
"| （＿人＿） |" & vbCrLf & _
"| ＼ | |" & vbCrLf & _
"＼ ＼＿| ／"
End Sub
コードの解説。
- (*)のところは、起動時のチェック。マクロ実行時に「Main」ワークシートのＢ列を選択しているかどうかとか、そういう最低限のチェックをしている。下の方の(*)を付けたメソッドでチェックしている。
- チェックを通らなかったら、(**)でユーザを煽る仕様ｗ
- (1)。選択中のセルを引数として渡してsetMailBasicDataメソッドを実行。これで、構造体変数「mldt」の各要素にデータがセットされる。
- (2)でMailDataクラスのインスタンスを生成。
- (3)でMailDataクラスのgetMailBasicDataメソッドに引数「mldt」を渡してプロパティに各データをセット。
- (4)から８行は、各データがちゃんとセットされているかどうかを確認するためのDebug.Print。
- 今度は本文データの取得とセット。(5)でカウント用変数「n」を初期化。
- (6)から７行のForループで、本文用の10個のセルのうち、文字列が入っているセルを数える。
列挙体で開始列番号と終了列番号を指定しているので、読みやすいと思う。 - (7)で空白セルかどうかを判定。空白なら(8)でループを抜ける。空白でなかったらカウント変数「n」をインクリメントする。
- Forループが終わると、「n」には本文の入ったセルの数、すなわち配列の要素数が入っていることになるので、(10)でsetMailBodyメソッドを引数として基準セルと配列の要素数「n」を渡して実行する。
- (10)の実行後は、配列「mlBody()」に本文データが格納されているので、(11)で、配列「mlBody」を引数として渡してMailDataクラスのgetMailBodyArrayメソッドを実行する。
- (12)は、メール本文のデータがちゃんとMailDataクラスのプロパティにセットされているかどうかをチェックするためのDebug.Print。
- (13)以降は、添付ファイルフルパスのセットと確認用のDebug.Print。本文データとほとんど同じ処理なので説明は省略。
- (14)以降は、送信者データのセットと確認用のDebug.Print。これも説明は省略。
とりあえず、ここまで。もし、(13)とか(14)のところの意味が分からなかったら、(5)～(12)までをよーく解読してみてほしい。まあ、あまりうまく説明できているとも思えないので、質問とか寄せてくださったらありがたい。
実行
「Main」ワークシートのＢ列を選択して実行すると……、
ほれ、この通り、イミディエイト・ウインドウに、無事全てのデータが表示されている。
これで、このワークブックから、必要な全てのデータが取得できた。あとは、LotusNotesとかThunderbirdとか、メーラーに合わせてメールを作成するメソッドを書けば良い。たぶん、OutLookにも対応できるだろう。
ちなみに、選択すべきセルを選択せずに実行すると、
こんな具合に煽られますwww
※「痴れ狗めぐぁーーーーーーッ！」ってのは、マンガ『蒼天航路』の董卓のセリフが元ネタです。
ひとりごと
それぞれのメーラーに合わせたメール作成用メソッドなんだけど、メーラーごとに別々のクラスを作って、同じメソッド名（たとえば「createMail」とか）にした方がいいんだろうか？
VBAでもInterfaceが使えるらしいんだけど、Interface型の変数が使えるんだったら、ポリモーフィズムができるということなんだろうか？ まあ、今のやり方だと「ポリモーフィズムが使えたとして何がうれしいんだよ！？」ということなんですけど……。
まだまだ勉強が必要ですね。そこら辺、詳しい人がいたらヒントをくれください。
メール自動作成マクロ用のクラスを作る
Excelから、VBAでLotusNotesやThunderbirdのメールを作るマクロ。
メンテナンスしやすくて拡張性のあるものにしたいと思って試行錯誤中。「これでうまく行くんじゃね？」というところまで漕ぎ着けたので、うｐしておく。
なるべく〈オブジェクト指向〉っぽくしたいんだけど、所詮素人なので、「オメー、そりゃダメだよｗ」というところがあったら、教えてください。
前回書いたように、
「Main」と名付けたワークシートに
こんな表を作って送信先アドレスとか本文とか添付ファイルのフルパスとかを入れておき、
「ユーザ情報」と名付けたワークシートに
こんな表を作って、送信者のデータを入れておくこととする。
んで、標準モジュールの宣言セクションでは、
'定数' Public Const EMBED_ATTACHMENT As Integer = 1454 Public Const MAIN_SHEET_NAME As String = "Main" Public Const MAIN_FONTSIZE As Integer = 12 '本文のフォントサイズ' Public Const SUB_FONTSIZE As Integer = 10 '添付ファイル名、署名のフォントサイズ'
定数の宣言をこんな風に（今回は関係ないのもあるけど）。
'構造体の宣言' Public Type mlData mailTo As String CC As String BCC As String mailSubject As String belongsTo As String jobTitle As String personName As String returnReceipt As String End Type '構造体変数の宣言' Public mldt As mlData
今回は、構造体変数を使用してみる。
'列挙体（列名を表すのに使用）' 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 md As MailData Public nsc As NotesStartedChecker 'モジュールレベル変数' Dim mlBody() As String Dim mlAttFiles() As String Dim mlSenderData() As String
あとは、クラスのインスタンス用のPublic変数と、モジュールレベル変数を準備する。
※「nsc」は今回は使いません。
クラスモジュールを挿入して、「オブジェクト名」を「MailData」にする。
クラスモジュールに下記のコードを書く。
Option Explicit 'フィールド' Private mailTo_ As String '送信先アドレス' Private CC_ As String 'CC' Private BCC_ As String 'BCC' Private mailSubject_ As String 'メール件名' Private belongsTo_ As String '送信相手の勤務先' Private jobTitle_ As String '送信相手の肩書' Private personName_ As String '送信相手の氏名' Private returnReceipt_ As String '受信確認の有無' Private mailBody_() As String 'メール本文の配列' Private attFiles_() As String '添付ファイルフルパスの配列' Private senderData_() As String '送信者データの配列' Private numOfBody_ As Integer 'メール本文配列の要素数' Private numOfAttFiles_ As Integer '添付ファイルフルパス配列の要素数' Private numOfSenderData_ As Integer '送信者データ配列の要素数' 'アクセサ' 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 mailSubject() As String mailSubject = mailSubject_ 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 personName() As String personName = personName_ End Property Public Property Get returnReceipt() As String returnReceipt = returnReceipt_ End Property Public Property Get mailBody(ByVal i As Integer) As String mailBody = mailBody_(i) End Property Public Property Get attFiles(ByVal i As Integer) As String attFiles = attFiles_(i) End Property Public Property Get senderData(ByVal i As Integer) As String senderData = senderData_(i) End Property Public Property Get numOfBody() As Integer numOfBody = numOfBody_ End Property Public Property Get numOfAttFiles() As Integer numOfAttFiles = numOfAttFiles_ End Property Public Property Get numOfSenderData() As Integer numOfSenderData = numOfSenderData_ End Property 'コンストラクタ' Private Sub Class_Initialize() End Sub 'メソッド' Public Sub getMailBasicData(ByRef mldt As mlData) '……(1)' 'メールの基礎データを取得する' mailTo_ = mldt.mailTo CC_ = mldt.CC BCC_ = mldt.BCC mailSubject_ = mldt.mailSubject belongsTo_ = mldt.belongsTo jobTitle_ = mldt.jobTitle personName_ = mldt.personName returnReceipt_ = mldt.returnReceipt End Sub Public Sub getMailBodyArray(ByRef mlBody() As String) '……(2)' 'メール本文の配列を取得する' Dim i As Integer numOfBody_ = UBound(mlBody()) '……(3)' ReDim mailBody_(numOfBody_) '……(4)' For i = 1 To UBound(mlBody()) mailBody_(i) = mlBody(i) '……(5)' Next End Sub Public Sub getMailAttFilesArray(ByRef mlAttFiles() As String) '……(6)' '添付ファイルフルパスの配列を取得する' Dim i As Integer numOfAttFiles_ = UBound(mlAttFiles()) ReDim attFiles_(numOfAttFiles_) For i = 1 To UBound(mlAttFiles()) attFiles_(i) = mlAttFiles(i) Next End Sub Public Sub getSenderDataArray(ByRef mlSenderData() As String) '……(7)' '送信者データの配列を取得する' Dim i As Integer numOfSenderData_ = UBound(mlSenderData()) ReDim senderData_(numOfSenderData_) For i = 1 To UBound(mlSenderData()) senderData_(i) = mlSenderData(i) Next End Sub Public Sub createLotusNotesMail() '……(8)' 'LotusNotesのメールを作成する' End Sub Public Sub createThunderbirdMail() '……(9)' 'Thunderbirdのメールを作成する End Sub
なんだかものすごく長いコードになってしまったが、前回との最大の違いは、
クラスとワークシートとの関係を完全に断ち切った
こと。
こうすることで、メール作成用のデータを入力したExcelワークシートの作り方が変わった場合でも、このクラスに関しては使い回しをすることができる。おおっ、ちょっと〈オブジェクト指向〉っぽいぞｗ
例によって、コードの解説。
- まず、コンストラクタがなくなっちゃってます。Private変数にデフォルト値が入って不都合な点が思い浮かばないので。コンストラクタのうまい使い道があったら教えてほしいぐらい。
- (1)は、メールの基礎情報……というか、実際は値が一つしかないようなパラメータを一気にMailDataオブジェクトのプロパティにセットするメソッド。引数を構造体で渡しているところがミソ。
- (2)は、本文の配列をMailDataオブジェクトのプロパティにセットするメソッド。引数に配列をまるごと渡している。
- 引数で渡された配列をUboundで調べたら要素数が分かるので、(3)でnumOfBodyプロパティにセット。
- その要素数を早速使って、(4)で仮配列mailBody_()をReDimする。
- あとは、Forループを使って(5)で引数として渡された配列の要素を、MailDataオブジェクトのプロパティ配列にセットしている。
- (6)では、添付ファイルのフルパスについて(2)と同じことをしている。
- (7)では、送信者のデータについて(2)と同じことをしているだけ。
- (8)と(9)は、今後実装予定のメソッド。(7)までで、およそメールを作成するために必要なデータは全て取得済みなので、あとはそれぞれのメーラーに合わせてメールを作成する処理を書けば良い。
で、このクラスにメール作成用のデータを渡す処理は、メール用データのあるワークシートの作りに合わせて標準モジュールに書く。まあ、これは、前回コンストラクタに書いていたものを移植すれば良いだけなので、もはや大した手間ではあるまい。
とりあえず、今回はここまで。このクラスにメール作成用データを渡す処理は、もう書いているんだけど、今回すでにかなり長くなってしまっているので、次回投稿します。
データ転記マクロ～その３
前回のマクロをさらに書き換える。
今度は、無駄にクラスモジュールを使うよ。
クラスモジュールを挿入して、オブジェクト名を「GambleRacer」にした。
クラスモジュールには下記のコードを書く。
Option Explicit
'フィールド '……(1)
Private rcID_ As Long
Private rcClass_ As String
Private rcRank_ As String
Private rcName_ As String
Private rcTerm_ As String
Private rcPref_ As String
Private rcTactics_ As String
'アクセサ '……(2)
Public Property Get rcID() As Long
rcID = rcID_
End Property
Public Property Get rcClass() As String
rcClass = rcClass_
End Property
Public Property Get rcRank() As String
rcRank = rcRank_
End Property
Public Property Get rcName() As String
rcName = rcName_
End Property
Public Property Get rcTerm() As String
rcTerm = rcTerm_
End Property
Public Property Get rcPref() As String
rcPref = rcPref_
End Property
Public Property Get rcTactics() As String
rcTactics = rcTactics_
End Property
'コンストラクタ
Private Sub Class_Initialize() '……(3)
With ActiveSheet
rcID_ = .Range("B3").Value 'No.
rcClass_ = .Range("B7").Value '級
rcRank_ = .Range("C7").Value '班
rcName_ = .Range("F3").Value '氏名
rcTerm_ = .Range("F5").Value '期別
rcPref_ = .Range("B5").Value '登録
rcTactics_ = .Range("F7").Value '戦法
End With
End Sub
'メソッドいつものように一応解説。
- (1)でクラス内でのみアクセス可能なPrivate変数を準備。プロパティとの対応関係が分かりやすいようにプロパティ名に「_」（アンダースコア）を付けている。
※これは、そもそもはこの方を意味も分からずマネしてただけなんですけど、便利さが分かってからずっと使っています。 - (2)はプロパティの値取得用のアクセサメソッドみたいなやつ。Propertyプロシージャという。
Propertyプロシージャの挙動については、ずっと前に書いたコチラもどうぞ。 - 今回はメンドクサイから、(3)みたいにコンストラクタ部分に書いたんですけど、ホントはメソッドとして書いた方がいいと思う。
※これだと他の場面で使い回しが効かないクラスになるよな……。
あ、ちなみに「コンストラクタ」ってのはインスタンス生成時に自動的に実行されるメソッドのことで、VBAでは「～～_Initialize()」って名前ですな。
まあ、クラスモジュール使いでない人から見たら、
なんでこんなにめんどくせーことするんだ！？
ってところでしょうね。
めんどくせーことついでに、標準モジュールの宣言セクションに、
Public Enum rcData
dtID = 1
dtClass
dtRank
dtName
dtTerm
dtPref
dtTactics
End Enumこんなものも用意しておくよ。
さらに、同じく標準モジュールの宣言セクションで、
Public gr As GambleRacerと、クラス用の変数を用意するのも忘れないようにしよう。
さて、ここまでで下ごしらえは完了。あとは、標準モジュールにメインのコードを書く。
Sub sendDataVer3()
'作業フォルダパスを変数に格納
Dim folderPath As String
folderPath = ThisWorkbook.Path
'アクティブシートを変数にセット
Dim objSheet As Worksheet
Set objSheet = ActiveSheet
'個票ブックのファイル名を変数にセット
Dim objFileName As String
objFileName = objSheet.Parent.Name
'データの転記
Set gr = New GambleRacer '……(1)
With ThisWorkbook.Worksheets("集約")
Dim tgtRow As Integer
tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(tgtRow, rcData.dtID).Value = gr.rcID 'No. '……(2)
.Cells(tgtRow, rcData.dtClass).Value = gr.rcClass '級
.Cells(tgtRow, rcData.dtRank).Value = gr.rcRank '班
.Cells(tgtRow, rcData.dtName).Value = gr.rcName '氏名
.Cells(tgtRow, rcData.dtTerm).Value = gr.rcTerm '期別
.Cells(tgtRow, rcData.dtPref).Value = gr.rcPref '登録
.Cells(tgtRow, rcData.dtTactics).Value = gr.rcTactics '戦法
End With
Set gr = Nothing
'個票ファイルを閉じてフォルダ移動
objSheet.Parent.Close False
Name folderPath & "\" & objFileName As _
folderPath & "\処理済\" & objFileName
End Sub
基本、前回のコードとほとんど同じ。変えたのは(1)のところと(2)以下の７行だけ。
- (1)はおなじみ、GambleRacerクラスのインスタンス生成。
- (2)以下の７行でデータ転記。
データ転記部分ですけど、メチャクチャ分かりやすいと思いませんか？
イコールの左辺部分では、セルの指定に列挙体を使用。意味のある文字列で指定しているので「Ａ」（列符号）とか「1」（列番号）で指定されるのに比べて格段に読みやすいと思う。
イコールの右辺についても、意味のある名前で指定しているから「Range("A3").Value」とか言われるよりよっぽど分かりやすいと思う。
「この程度の処理にクラスモジュールを使うなんて……」と眉を顰める向きもあろうが、最初に余分な手間をかけるだけのネウチは十分すぎるほどにあると思うのですがいかがでしょうか。
データ転記マクロ～その２
前回の転記用マクロを書き換えてみる。
元のコードを下に再掲。ただし、余計なコメントは除去。コメント入りがご所望ならコチラをどうぞ。
Sub sendDataVer1()
Dim folderPath As String
folderPath = ThisWorkbook.Path
Dim objSheet As Worksheet
Set objSheet = ActiveSheet
Dim objFileName As String
objFileName = objSheet.Parent.Name
With ThisWorkbook.Worksheets("集約")
Dim tgtRow As Integer
tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & tgtRow).Value = objSheet.Range("B3").Value 'No. '……(*)
.Range("B" & tgtRow).Value = objSheet.Range("B7").Value '級
.Range("C" & tgtRow).Value = objSheet.Range("C7").Value '班
.Range("D" & tgtRow).Value = objSheet.Range("F3").Value '氏名
.Range("E" & tgtRow).Value = objSheet.Range("F5").Value '期別
.Range("F" & tgtRow).Value = objSheet.Range("B5").Value '登録
.Range("G" & tgtRow).Value = objSheet.Range("F7").Value '戦法
End With
objSheet.Parent.Close False
Name folderPath & "\" & objFileName As _
folderPath & "\処理済\" & objFileName
End Sub(*)の部分がいかにもブサイクなので書き換える。
その前に、セルに名前を付ける。
こんな風に名前の中に連番をかましておくと、たとえば
Range("data" & Format(i, "0#"))って書いたら、変数「i」のインクリメントで名前を付けたセルを順番に取得できる。
これを生かして、上掲コードの(*)の部分を
Dim i As Integer '……(*)'
For i = 1 To 7
.Cells(tgtRow, i).Value = Range("data" & Format(i, "0#")).Value '……(1)
Nextと書き換えてやれば、７つのデータの転記を３行で書くことができる（変数宣言も入れたら４行だけど）。ただ、難点はコードの可読性が下がることだな。一応コードの説明をしておこう。
- (1)をForループで７回回すことになる。
- ループ１回目は、「i」が「1」なので、１列目（＝Ａ列）に「Data01」という名前のセルの値を書き込む。
- ループ２回目は、「i」が「2」なので、２列目（＝Ｂ列）に「Data02」という名前のセルの値を書き込む。
- 以下、「i」が「7」になるまで繰り返す。
一応コードを全部載っけとく。
Sub sendDataVer2()
'作業フォルダパスを変数に格納
Dim folderPath As String
folderPath = ThisWorkbook.Path
'アクティブシートを変数にセット
Dim objSheet As Worksheet
Set objSheet = ActiveSheet
'個票ブックのファイル名を変数にセット
Dim objFileName As String
objFileName = objSheet.Parent.Name
'データの転記
With ThisWorkbook.Worksheets("集約")
Dim tgtRow As Integer
tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim i As Integer '……(*)'
For i = 1 To 7
.Cells(tgtRow, i).Value = Range("data" & Format(i, "0#")).Value '……(1)
Next
End With
'個票ファイルを閉じてフォルダ移動
objSheet.Parent.Close False
Name folderPath & "\" & objFileName As _
folderPath & "\処理済\" & objFileName
End Sub実行すると、
ほれ、この通り。
ただ、上にも書いたけど、コードの可読性が下がっているというのは問題だと思う。初心者がちょっと腕前が上がってくるとこんなコードを書きがちなんじゃないかな。「オレならもっと短く書けるぜ！」みたいな感じで。んで、いろいろひねくり回して短いコードを書いた挙げ句、後で自分で読んで意味が分からず解読に時間がかかるとかｗ
文章なんかでもそうだけれど、短さと読みやすさは必ずしも比例しない。ブサイクかも知れないけど先に挙げた「sendDataVer1」の方が良いのかも知れませんね。
データ転記マクロ
VBA初心者向けブログみたいなタイトルなのに、全然初心者向けじゃなかったので、ちょっと初心者の頃を思い出して書く。
私がVBAにハマるきっかけになったマクロです。
こんな個票のデータを、
こんな集約表に転記していく、という作業です。
集約用のExcelファイルと、データ個票のExcelファイルは、この「集約テスト」フォルダの中に、
こんな風に収まっているという想定で。
「データ集約用.xlsm」の標準モジュールに以下のコードを書く。
Option Explicit
Sub sendDataVer1()
'作業フォルダパスを変数に格納
Dim folderPath As String
folderPath = ThisWorkbook.Path
'アクティブシートを変数にセット
Dim objSheet As Worksheet
Set objSheet = ActiveSheet '……(1)
'個票ブックのファイル名を変数にセット
Dim objFileName As String
objFileName = objSheet.Parent.Name '……(2)
'データの転記
With ThisWorkbook.Worksheets("集約") '……(3)
Dim tgtRow As Integer
tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '……(4)
.Range("A" & tgtRow).Value = objSheet.Range("B3").Value 'No '……(5)
.Range("B" & tgtRow).Value = objSheet.Range("B7").Value '級
.Range("C" & tgtRow).Value = objSheet.Range("C7").Value '班
.Range("D" & tgtRow).Value = objSheet.Range("F3").Value '氏名
.Range("E" & tgtRow).Value = objSheet.Range("F5").Value '期別
.Range("F" & tgtRow).Value = objSheet.Range("B5").Value '登録
.Range("G" & tgtRow).Value = objSheet.Range("F7").Value '戦法
End With
'個票ファイルを閉じてフォルダ移動
objSheet.Parent.Close False '……(6)
Name folderPath & "\" & objFileName As _
folderPath & "\処理済\" & objFileName '……(7)
End Subかなり細かくコメントを入れているので、説明不要かも知れないけど、一応説明。
(1)の
Set objSheet = ActiveSheet
でアクティブシートを変数にセットしている。このマクロは、個票ファイルのシートを開いた状態で実行するので、データが入っているシートを変数にセットしておく。ActiveSheetのままだと、途中でActiveSheetが切り替わってしまったときに思いもかけない結果になることがあるので一応。
(2)の
objFileName = objSheet.Parent.Name
で、個票ブックのファイル名を取得しておく。後の転記のことを考えて、シートを変数にセットしたので、ブック名はParentプロパティから取得している。子オブジェクトからさかのぼって親オブジェクトの値を取得することができるというのはちょっとした便利ワザかも。
(3)の
With ThisWorkbook.Worksheets("集約")
で、ThisWorkbook.Worksheets("集約")というWorkheetオブジェクトに関する記述をまとめているので、以後10行下のEnd Withまでの間、「.」（ピリオド）で書き始めると、ThisWorkbook.Worksheets("集約")が省略されているとみなされる。
(4)の
tgtRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
で、転記先（集約シート）のデータ記入済み最終行の次の行の番号を割り出している。このやり方は手が勝手に動くレベルまでマスターしておくべき。データ転記系の処理ではやたらよく使うので。
いちおうコードを翻訳しておくと、
１列目（Ａ列）の全行数行目（要するに最終行）から上方向にデータが入っているセルに突き当たった行の行番号＋１を変数tgtRowに代入せよ
ということ。
(5)からの７行
.Range("A" & tgtRow).Value = objSheet.Range("B3").Value 'No.'
.Range("B" & tgtRow).Value = objSheet.Range("B7").Value '級'
.Range("C" & tgtRow).Value = objSheet.Range("C7").Value '班'
.Range("D" & tgtRow).Value = objSheet.Range("F3").Value '氏名'
.Range("E" & tgtRow).Value = objSheet.Range("F5").Value '期別'
.Range("F" & tgtRow).Value = objSheet.Range("B5").Value '登録'
.Range("G" & tgtRow).Value = objSheet.Range("F7").Value '戦法'
で一つ一つデータを転記している。すげー原始的な書き方だけど、初心者のうちはこれで良いと思う。
(6)の
objSheet.Parent.Close False
は超重要。個票ファイルを保存せずに閉じている。この「閉じる」という手順を抜かすと、次のNameステートメントの実行でエラーが出る。
(7)の
Name folderPath & "\" & objFileName As _
folderPath & "\処理済\" & objFileName
がフォルダ移動の処理。初心者にはとっつきにくく感じる処理かも知れない。普通、フォルダ移動って「切り取って貼り付ける」ってイメージだから。でもファイルシステム的にはファイルフルパスを書き換えたらディレクトリが変わるってことだから、こうなる。
まず、集約用ブックを開いておいて、クイック アクセス ツールバーに今回のマクロを登録しておく。
個票ファイルを開いたら、クイック アクセス ツールバーのアイコンをクリック！
ほれ、一瞬でデータが転記されておる。
次のファイルを開いて、クイック アクセス ツールバーのアイコンをクリック！
ほれ、この通り。
この段階で、フォルダ内はこの通り。処理済みのファイルはもうここにはない。
同じように、個票ファイルを開いてはクイック アクセス ツールバーのアイコンをクリック、を繰り返すと、転記完了。
んで、「処理済」フォルダの中はこの通り。
コード面ではツッコミどころ満載ですが、データ転記系の業務が多い場合は、これをマスターしたらかなり楽になると思う。
