FileSystemObjectを用いてテキストファイルを読み込む

〈FileSystemObject使い宣言〉をしていた（いつ？！）にもかかわらず、

akashi-keirin.hatenablog.com

このときは、テキストファイルの読み込みにFileSystemObjectを利用していなかった。

深く反省して、FileSystemObjectを用いる形に書き換えたい。

TextFileクラスのコード

めんどくさいので、改良（？）したTextFileクラスのコードを全掲載する。

リスト１　クラスモジュール

'オブジェクト名は"TextFile"。'
Option Explicit

'Constants'
Private Enum ErrorTypes
  etFileNotFound = 1
  etLineNotExists
  etNotInitialized
  etErrorOccurred
End Enum

'Module Level Variables'
Private isInitialized As Boolean
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"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  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, ERR_SOURCE)
End Property

Public Property Get LineCount() As Long
  Const ERR_SOURCE As String = "TextFile Class, Property Get LineCount"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  Dim ret As Long
  If IsEmpty(line_) Then ret = 0: GoTo Finalizer
  ret = UBound(line_) + 1
Finalizer:
  LineCount = ret
End Property

'Constructor'
Private Sub Class_Initialize()
  isInitialized = False
  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
  'テキストファイルからデータを取得'
  line_ = getLines(targetFullName)
  isInitialized = True
End Sub
'テキストファイル読み込み'
Private Function getLines( _
             ByVal targetFullName As String) As String()
  Dim ret() As String
  Dim n As Long
  n = 0
  ReDim ret(n)
  Dim txtStream As Scripting.TextStream
  Set txtStream = fsObj.OpenTextFile( _
                          FileName:=targetFullName, _
                          IOMode:=ForReading, _
                          Create:=False)
  Do
    ret(n) = txtStream.ReadLine
    '最終行まで読み込んだらExit'
    If txtStream.AtEndOfLine Then Exit Do
    n = n + 1
    ReDim Preserve ret(n)
  Loop
  Call txtStream.Close
  Set txtStream = Nothing
  line_ = ret
  getLines = line_
End Function

'Destructor'
Private Sub Class_Terminate()
  Set fsObj = Nothing
End Sub

'Methods'
Public Sub regetData(Optional ByVal targetFullName As String)
  Const ERR_SOURCE As String = "TextFile Class, regetData Method"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  If targetFullName = "" Then GoTo MainProcess
  If Not fsObj.FileExists(targetFullName) Then _
    Call raiseError(etFileNotFound, ERR_SOURCE)
  '新たにファイルフルパスが渡されたら、それを新しいファイルフルパスにする'
  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 etNotInitialized: ret = "You must run ""init"" method!"
    Case etErrorOccurred: ret = "Some Error has occurred"
  End Select
  getErrorMessage = ret
End Function

すまん。すっげえタテ長になってしまった。

テキストファイル読み込み部分だけ取り上げる。

リスト２　クラスモジュール

Private Function getLines( _
             ByVal targetFullName As String) As String()
  Dim ret() As String
  Dim n As Long
  n = 0
  ReDim ret(n)
  Dim txtStream As Scripting.TextStream    '……(1)'
  Set txtStream = fsObj.OpenTextFile( _
                          FileName:=targetFullName, _
                          IOMode:=ForReading, _
                          Create:=False)
  Do    '……(2)'
    ret(n) = txtStream.ReadLine
    '最終行まで読み込んだらExit'
    If txtStream.AtEndOfLine Then Exit Do
    n = n + 1
    ReDim Preserve ret(n)
  Loop
  Call txtStream.Close
  Set txtStream = Nothing
  line_ = ret
  getLines = line_
End Function

目玉は二つ。

まずは、(1)からの５行（実質２行）

Dim txtStream As Scripting.TextStream
Set txtStream = fsObj.OpenTextFile( _
                        FileName:=targetFullName, _
                        IOMode:=ForReading, _
                        Create:=False)

FileSystemObjectクラスのOpenTextFileメソッドは、TextStreamオブジェクトを返す。

最初、

Dim txtStream As

と入力してもTextStreamが入力候補に出なかったので焦ったが、

Dim txtStream As Scripting.

まで入力したら、ちゃんとTextStreamが出た。

あとは、(2)からの７行（正味６行）

Do    '……(2)'
  ret(n) = txtStream.ReadLine
  '最終行まで読み込んだらExit'
  If txtStream.AtEndOfLine Then Exit Do
  n = n + 1
  ReDim Preserve ret(n)
Loop

最初、ReadLineメソッドに引数がないので、

おい小池、行数指定できねえのかよ！

と思ったのだが、Doループで回すだけで順番に取り出してくれているっぽい。

任意の行を指定したいときにはどうすれば良いのかわからないが、全ての行を取り出すには実に好都合だ。

終了判定は、

If txtStream.AtEndOfLine Then Exit Do

のように、AtEndOfLineプロパティで行うことが可能。

実にわかりやすい。

実行

次のコードで使用実験。

リスト３　標準モジュール

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 ar() As String
  Dim i As Long
  For i = 1 To txtFile.LineCount
    Debug.Print txtFile.Line(i)
  Next
End Sub

このプロジェクトと同じフォルダ内に「test.txt」というテキストファイルを置いておく。

テキストファイルの内容は、

f:id:akashi_keirin:20190712084949j:plain