テキストファイルの内容を保持するクラス
テキストファイルの内容を保持するクラス
処理に必要な値の中で、〈ほぼ静的なんだけどちょっと動的な値〉、つまり、滅多に変更することはないのだけれど、たまに変更が生ずるような値があると、実にめんどくさい。
これがExcelの場合だと、設定値書き込み用のシートを置いておけば、そのシートを設定ファイル代わりに使えて便利だ。
しかし、WordやPowerpointなどだとそうはいかない。
まあ、〈滅多に変更することがない値〉なので、モジュールに定数として書いてしまう、という対応をよくする。
実用上、これで困ることはほぼないのだが、それでもやはりたまに訪れる変更のときに、いちいちVBEを開いて書き換える、というのもイマイチな気がする。
ほかには、たとえば、CustomDocumentPropertiesを用いるという手もあるが、それとていちいちDocumentなりPresentationなりを開かねばならんので、やはりめんどくさい。
そこで、テキストファイルですよ！
テキストファイルを用いる
プロジェクトの外側に設定用のテキストファイルを置いておけば、設定変更したいときはそのテキストファイルを書き換えれば済むのだから、ユーザとしてはずいぶん楽になる。
しかし、コーディングという観点からすれば、VBAからテキストファイルを操るのは、（めったに使わないステートメントを使わねばならんこともあって）かなりめんどくさい。
それならば、クラスでラップしちまえば良いのですよ。
TextFileクラス
テキストファイルの各行の文字列をインスタンス内に保持して、必要に応じて対象行の文字列を返すシンプルなクラスにしてみた。
とりあえず、書いたコードをぶちまける。
クラスモジュール TextFile
Option Explicit 'Constants' Private Enum ErrorTypes etFileNotFound = 1 etLineNotExists etErrorOccurred End Enum 'Module Level Variables' Private fileFullName As String Private line_() As String Private fsObj As FileSystemObject 'Properties' Public Property Get Line(ByVal numberOf As Long) As String Const ERR_SOURCE As String = "TextFile Class, Property Get Line" Dim ret As String '存在しない行番号を指定していたらエラー。' If UBound(line_) + 1 < numberOf Or _ numberOf < 0 Then _ Call raiseError(etLineNotExists, ERR_SOURCE) On Error GoTo ErrorHandler ret = line_(numberOf - 1) Line = ret Exit Property ErrorHandler: '何かしらエラーが出たら、イミディエイトに情報を表示して中断。' Debug.Print "Number : " & Err.Number Debug.Print "Description : " & Err.Description Call raiseError(etErrorOccurred, "") End Property Public Property Get LineCount() As Long Dim ret As Long If IsEmpty(line_) Then ret = 0: GoTo Finalizer ret = UBound(line_) + 1 Finalizer: LineCount = ret End Property 'Constructors' Private Sub Class_Initialize() Set fsObj = New FileSystemObject End Sub Public Sub init(ByVal targetFullName As String) '対象ファイルの存否確認。なければエラー。' If Not fsObj.FileExists(targetFullName) Then _ Call raiseError(etFileNotFound, "TextFile Class, init Method") 'モジュールレベル変数に対象ファイルのフルパスを保存' fileFullName = targetFullName 'テキストファイルを開いて、データを取得' Dim n As Long n = FreeFile(0) Open fileFullName For Input As n Dim LineCount As Long LineCount = 1 Do ReDim Preserve line_(LineCount - 1) Line Input #n, line_(LineCount - 1) LineCount = LineCount + 1 Loop Until EOF(n) Close n End Sub 'Destructor' Private Sub Class_Terminate() Set fsObj = Nothing End Sub 'Methods' Public Sub regetData(Optional ByVal targetFullName As String) If targetFullName = "" Then GoTo MainProcess If Not fsObj.FileExists(targetFullName) Then _ Call raiseError(etFileNotFound, "TextFile Class, regetData Method") '新たにファイルフルパスが渡されたら、それを新しいファイルフルパスにする' fileFullName = targetFullName MainProcess: Erase line_ Call Me.init(fileFullName) End Sub Private Sub raiseError(ByVal typeOfError As ErrorTypes, _ Optional ByVal errorSource As String) Dim msg As String msg = getErrorMessage(typeOfError) Call Err.Raise(Number:=10000 + typeOfError, _ Source:=errorSource, _ Description:=msg) End Sub Private Function getErrorMessage( _ ByVal typeOfError As ErrorTypes) As String Dim ret As String Select Case typeOfError Case etFileNotFound: ret = "The file you specified isn't found." Case etLineNotExists: ret = "This file doesn't have so many lines." Case etErrorOccurred: ret = "Some Error has occurred" End Select getErrorMessage = ret End Function
パーツごとに見ておこう。
Constants
Private Enum ErrorTypes etFileNotFound = 1 etLineNotExists etErrorOccurred End Enum
クラス内でエラーが起こった場合の対応を分岐するために、列挙体を作った。
この値に応じてgetErrorMessageメソッドでエラーメッセージを取得して、raiseErrorメソッドでエラーを起こすのに使う。
Module Level Variables
Private fileFullName As String Private line_() As String Private fsObj As FileSystemObject
クラスモジュール内で通用するモジュールレベル変数。
fileFullNameには、テキストファイルのフルパスを保存する。
line_()には、テキストファイルから読み込んだ文字列を、配列にしてぶちこんでおく。
fsObjは、FileSystemObjectのインスタンス用。ファイルやフォルダの存否確認に必ず用いるので、クラス内にPrivateで置いておく。
Properties
Public Property Get Line(ByVal numberOf As Long) As String
Const ERR_SOURCE As String = "TextFile Class, Property Get Line"
Dim ret As String
'存在しない行番号を指定していたらエラー。'
If UBound(line_) + 1 < numberOf Or _
numberOf < 0 Then _
Call raiseError(etLineNotExists, ERR_SOURCE)
On Error GoTo ErrorHandler
ret = line_(numberOf - 1)
Line = ret
Exit Property
ErrorHandler:
'何かしらエラーが出たら、イミディエイトに情報を表示して中断。'
Debug.Print "Number : " & Err.Number
Debug.Print "Description : " & Err.Description
Call raiseError(etErrorOccurred, "")
End Property
Public Property Get LineCount() As Long
Dim ret As Long
If IsEmpty(line_) Then ret = 0: GoTo Finalizer
ret = UBound(line_) + 1
Finalizer:
LineCount = ret
End Property
プロパティはとりあえず二つだけ。
Lineプロパティは、対象のテキストファイルの文字列の内、引数で指定した行の文字列を返す。
変な引数が与えられたときにはエラーを起こすようにしている。
LineCountプロパティは、テキストファイルの行数を返す。
とりあえずはこれだけ。
Constructors
Private Sub Class_Initialize()
Set fsObj = New FileSystemObject
End Sub
Public Sub init(ByVal targetFullName As String)
'対象ファイルの存否確認。なければエラー。'
If Not fsObj.FileExists(targetFullName) Then _
Call raiseError(etFileNotFound, "TextFile Class, init Method")
'モジュールレベル変数に対象ファイルのフルパスを保存'
fileFullName = targetFullName
'テキストファイルを開いて、データを取得'
Dim n As Long
n = FreeFile(0)
Open fileFullName For Input As n
Dim LineCount As Long
LineCount = 1
Do
ReDim Preserve line_(LineCount - 1)
Line Input #n, line_(LineCount - 1)
LineCount = LineCount + 1
Loop Until EOF(n)
Close n
End Sub
コンストラクタに引数を渡すことができないVBAの悲しい性により、コンストラクタが二つもある。
一つ目はFileSystemObjectのインスタンスをfsObjにぶち込むだけ。必ず使用するのだから、ここでセットしておくのが良いと思った。
もう一つのinitメソッドがこのクラスの中枢部分。
テキストファイルから各行の文字列を取り出して配列に格納。
データの抜き出しが終わったら、テキストファイルは用無しなので、閉じてしまう。必要ならまた開けば良い。
Destructor
Private Sub Class_Terminate() Set fsObj = Nothing End Sub
これはまあ、FileSystemObjectのインスタンスを破棄しているだけ。別にいらんといえばいらんけど。
Methods
Public Sub regetData(Optional ByVal targetFullName As String)
If targetFullName = "" Then GoTo MainProcess
If Not fsObj.FileExists(targetFullName) Then _
Call raiseError(etFileNotFound, "TextFile Class, regetData Method")
'新たにファイルフルパスが渡されたら、それを新しいファイルフルパスにする'
fileFullName = targetFullName
MainProcess:
Erase line_
Call Me.init(fileFullName)
End Sub
Private Sub raiseError(ByVal typeOfError As ErrorTypes, _
Optional ByVal errorSource As String)
Dim msg As String
msg = getErrorMessage(typeOfError)
Call Err.Raise(Number:=10000 + typeOfError, _
Source:=errorSource, _
Description:=msg)
End Sub
Private Function getErrorMessage( _
ByVal typeOfError As ErrorTypes) As String
Dim ret As String
Select Case typeOfError
Case etFileNotFound: ret = "The file you specified isn't found."
Case etLineNotExists: ret = "This file doesn't have so many lines."
Case etErrorOccurred: ret = "Some Error has occurred"
End Select
getErrorMessage = ret
End Function
メソッドは今のところ三つ。
とはいえ、最後のgetErrorMessageメソッドはraiseErrorメソッドの下請けみたいなもんなので、実質二つ。
しかも、raiseErrorメソッドは、エラーが出たときの内部メソッドに過ぎないので、実質は一つみたいなもん。
で、その唯一のregetDataメソッドは、テキストファイルからのデータ再取得メソッド。
将来的に、このTextFileクラスを介してテキストファイルを書き換えるようなメソッドを置いたような場合に、設定の再取得ができるように作っただけ。今のところ使い道はない。
実験
次のようなテキストファイルを用意する。
マクロを実行するプロジェクト（今回はWord VBAを使うので、Wordドキュメント。）と同じフォルダ内に、「Test.txt」という名前にして置いておく。
そうして、次のコードで実験。
リスト２ 標準モジュール
Private Sub testTextFileClass()
Dim targetPath As String
targetPath = ThisDocument.Path & "\" & "test.txt" '"
Dim txtFile As TextFile
Set txtFile = New TextFile
Call txtFile.init(targetPath)
Dim i As Long
For i = 1 To txtFile.LineCount
Debug.Print txtFile.Line(i)
Next
Call txtFile.regetData(targetPath)
For i = 1 To txtFile.LineCount
Debug.Print txtFile.Line(i)
Next
End Sub
TextFileクラスのインスタンスを生成し、「Test.txt」のフルパスを渡して初期化。
Lineプロパティの中身を全てイミディエイト・ウインドウに吐き出させる。
その後、regetDataメソッドで再度「Test.txt」のデータを読み込んで、Lineプロパティの中身を全てイミディエイト・ウインドウに吐き出させる。
もちろん、「Test.txt」の中身は変わらないので、同じ出力が二度あるだけだが。
実行結果
意図どおり。
おわりに
クラスにしたので、設定ファイルが複数種類あっても、それぞれインスタンスを作ればよい。
また、たとえば、
テキストファイルの１行目が保存用フォルダ名、２行目が差込印刷データソースのファイル名、３行目が差込データテーブルの名前
だったら、呼び出し側のモジュールに
Private Enum SettingData sdSaveFolderName = 1 sdDataSourceFileName sdDataSourceTableName End Enum
のような列挙体を作成しておき、
txtFile.Line(sdSaveFolderName)
のような形で呼び出すようにすれば、非常にreadableになると思う。
追記
TextFileクラスは新しくなりました。(2019/07/17)
さらに追記
今はこんなことになっています。
