簡易版TextFileクラスを作った

簡易版TextFileクラスを作った

テキストファイルの扱いとか、FileSystemObjectのTextStreamオブジェクトとか、ADODBオブジェクトあたりのことがよくわかっていないので、テキストファイルの中身を簡単に取得するためのクラスを作った。

クラスモジュールを触るのがめっちゃ久しぶりだったので、まあまあ苦戦した。

テキストファイルを読み込んで内容を保持するクラス

その名もEasyTextFileクラス。

機能は最小限にした。

テキストファイルのパスと文字コード（いちおう、Shift_JIS、UTF-8、UTF-16の3種類に対応している。ただ、私は素人なので、文字コードのこととか、実はよくわかっていない。）

まあ、Scripting.FileSystemObjectオブジェクトとADODB.Streamオブジェクトをラップしているだけ。

リスト１

クラスモジュールEasyTextFile

Option Explicit

'設定用のテキストファイルを読み込むためだけに使うクラス'
'必要最小限の機能にとどめる'

'Public enums'
'Enumerations for Scripting.FileSystemObject object'
Public Enum TFCharCode
  tfShiftJIS = 0
  tfUTF8 = 1
  tfUTF16 = -1
'  tfUseDefault = -2'
End Enum

'Private enums'
'Enumerations for Scripting.FileSystemObject'
Private Enum IOMode
  ForReading = 1
  ForWriting = 2
  ForAppending = 8
End Enum

Private Enum Tristate
  TristateFalse = 0
  TristateTrue = -1
  TristateUseDefault = 2
End Enum

'Enumerations for error'
Private Enum TFErrType
  tfErrNotInitialized = 1
  tfErrFileNotExist
  tfErrArgInvalid
End Enum

'Constants'
Private Const ERR_NUMBER As Long = 10000

'Module level variables'
Private m_FSO As Object
Private m_TextStream As Object
Private m_ADOStream As Object
Private m_HasInitialized As Boolean

'Field variables'
Private m_Path As String
Private m_TextLines As Collection

'Constructor'
Private Sub Class_Initialize()
  Set m_FSO = CreateObject("Scripting.FileSystemObject")
  Set m_ADOStream = CreateObject("ADODB.Stream")
  Set m_TextLines = New Collection
End Sub

Public Sub Init(ByVal a_Path As String, _
                ByVal a_CharCode As TFCharCode)
  'If file not exists, raise error.'
  If Not m_FSO.FileExists(a_Path) Then
    Call raiseError(tfErrFileNotExist)
  End If
  m_Path = a_Path
  m_HasInitialized = True
  Dim tmp As String
  Dim n As Long
  n = 1
  Select Case a_CharCode
    Case tfUTF8
    'UTF-8のテキスト読み込み'
      With m_ADOStream
        .Charset = "UTF-8"
        Call .Open
        Call .LoadFromFile(Me.Path)
        Do Until .EOS
          tmp = .ReadText(adReadLine)
          Call m_TextLines.Add(tmp, CStr(n))
          n = n + 1
        Loop
      End With
      '読み込みが終わったら閉じる'
      Call m_ADOStream.Close
    Case tfShiftJIS
    'Shift_JISのテキスト読み込み'
      Call readFromTextSteram(tfShiftJIS)
    Case tfUTF16
    'UTF-16のテキスト読み込み'
      Call readFromTextSteram(tfUTF16)
  End Select
End Sub

Private Sub readFromTextSteram(ByVal a_CharCode As TFCharCode)
  Set m_TextStream = m_FSO.OpenTextFile(FileName:=Me.Path, _
                                        IOMode:=ForReading, _
                                        Create:=False, _
                                        Format:=a_CharCode)
  Dim tmp As String
  Dim n As Long
  n = 1
  With m_TextStream
    Do Until .AtEndOfStream
      tmp = .ReadLine
      Call m_TextLines.Add(Item:=tmp, Key:=CStr(n))
      n = n + 1
    Loop
  End With
  Call m_TextStream.Close
End Sub

'Destructor'
Private Sub Class_Terminate()
  Set m_ADOStream = Nothing
  Set m_TextStream = Nothing
  Set m_TextLines = Nothing
End Sub

'Properties'
Public Property Get Path() As String
  If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized)
  Path = m_Path
End Property

Public Property Get FileName() As String
  If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized)
  Dim ret As String
  ret = m_Path
  Dim arr() As String
  arr = Split(ret, "\") '"
  ret = arr(UBound(arr))
  FileName = ret
End Property

Public Property Get LinesCount() As Long
  If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized)
  LinesCount = m_TextLines.Count
End Property

Public Property Get LineText(ByVal a_Index As Variant) As String
  If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized)
  If Not IsNumeric(a_Index) Then Call raiseError(tfErrArgInvalid)
  If CLng(a_Index) < 0 Or _
     CLng(a_Index) > Me.LinesCount Then Call raiseError(tfErrArgInvalid)
  LineText = m_TextLines.Item(CStr(a_Index))
End Property

'Methods'

'Raise Error'
Private Sub raiseError(ByVal a_ErrType As TFErrType)
  Call Err.Raise(Number:=ERR_NUMBER + a_ErrType, _
                 Description:=getErrMessage(a_ErrType))
  Call Err.Clear
End Sub

Private Function getErrMessage( _
             ByVal a_ErrType As TFErrType) As String
  Dim ret As String
  Select Case a_ErrType
    Case tfErrNotInitialized: ret = "Sorry, class has not initialized yet..."
    Case tfErrFileNotExist: ret = "Sorry, file not exists..."
    Case tfErrArgInvalid: ret = "Sorry,argument is invalid... "
  End Select
  getErrMessage = ret
End Function

穴だらけなのだと思うけれど、一応エラー処理っぽいものも入れた。

使ってみる

準備

フォルダ内に、次の三つのテキストファイルを用意する。

上から順に、

• 文字コードUTF_8のち～んｗ.aho
• 文字コードShift_JISのち～んｗbyShiftJIS.txt
• 文字コードUTF_8のち～んｗbyUTF8.txt

このとおり。一つ目は、拡張子を.txtではなく、.ahoというわけのわからないものにしている。当然、中身はただのテキストファイルである。

ち～んｗbyShiftJIS.txtを開いたところ。

ち～んｗbyUTF8.txtを開いたところ。

ち～んｗ.ahoを開いたところ。

こんな感じ。

テキストファイルの内容をイミディエイトに出力するマクロ

たとえば、一つ目のち～んｗbyShiftJIS.txtの内容をイミディエイトに書き出すコードは次の通り。

リスト２

Private Sub test01()
  Dim etf As EasyTextFile
  Set etf = New EasyTextFile
  Dim flPath As String
'==================================================================='
  flPath = ActiveDocument.Path & "\ち～んｗbyShiftJIS.txt '"
  Call etf.Init(flPath, tfShiftJIS)
'==================================================================='
  Debug.Print "Read from the file called """ & etf.FileName & """..."
  Dim i As Long
  For i = 1 To etf.LinesCount
    Debug.Print etf.LineText(i)
  Next
End Sub

「===」で囲ったところで、ファイルの指定と文字コードの指定をしている。

二つ目のち～んｗbyUTF8.txtなら、ここを

flPath = ActiveDocument.Path & "\ち～んｗbyUTF8.txt"
Call etf.Init(flPath, tfUTF8)

にすりゃいいし、三つ目のち～んｗ.ahoなら、

flPath = ActiveDocument.Path & "\ち～んｗ.aho"
Call etf.Init(flPath, tfUTF8)

にするだけ。

実行結果

一つ目。

うむ。

二つ目。

ふむ。

むふふ。

バッチリである！

おわりに

特にWordなんかをVBAで動かすときには、処理用のデータをどこに置くかで困ることが多い。

私は、テキストファイルで外部化することが多いっす。