VBAで文字 コードを指定してファイル入出力を行うUtilityを作ってみた

VBAでファイルなどでシステム間連携をしている場合に、結構実装の手間がかかるのがUTF-8での入出力です。

何故なら、VBAで標準で用意されている以下はSHIFT-JISにしか対応していないためです。

  • 「 Open→Print→Close」での書き出し
  • 「Open→Line Input →Close」での書き出し

でも今時のシステムで「SHIFT-JIS」を使用していることなんて少ないでしょうから、上記関数をそのまま使うことは出来ないことが大半です。

(そもそも、今時のシステムでVBA連携なんてしねーよって突っ込みもありそうですが…)

頻繁に使用する機能は、すぐに使えるように共通部品化しておきたいところです。

そこで文字コードを指定してファイルの入出力を行えるUtilityクラスを作ってみました。

作成したクラス

ADOを使用したファイル入出力を行うクラスです。

ADOを使用するのは、ぶっちゃけ手軽にできるものでこれ以外は知らないからです。(もし、あったら教えてほしいです。)

ソース

Private path As String
Private obj As Object
Private isOpen As Boolean
Private separator As String
Private bom As Boolean

Public Sub initialize(filepath As String, _
                            charset As String, _
                            Optional fileseparator As String = vbCrLf, _
                            Optional bomflg As Boolean = true)
                            
    '引数からファイルのパスを貰ってフィールドに入れる
    path = filepath
    '引数から文字コードを貰ってフィールドに入れる
    Set obj = CreateObject("ADODB.Stream")
    obj.charset = charset
    separator = fileseparator
    bom = bomflg
    
    '後処理
    Dir (vbNullString)
End Sub

Private Sub Class_Terminate()
    '後処理
    Set obj = Nothing
End Sub

'ファイルを読み込んで配列に格納
Public Function read() As String()
    Dim buf As String
    With obj
        .Open
        .LoadFromFile path
        buf = .ReadText
        .Close
    End With
    
    read = Split(buf, separator)
End Function

'ファイルに文字列を出力(新規作成モード)
Public Sub out(str() As String)
    Dim FSO As Object
    Dim buf As String
    Dim temp() As Byte
    Dim i As Integer
    
    'エラーになるので前のファイルを削除
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'FSO.DeleteFile path
    Set FSO = Nothing
    
    For i = 0 To UBound(str)
        If buf = "" Then
            buf = str(i)
        Else
            buf = buf + separator + str(i)
        End If
    Next i
    
    With obj
        .Open
        .LoadFromFile path
        .WriteText buf, 0
        If Not bom Then
            .Position = 0
            .Type = 1
            .Position = 3
            temp = .read
            .Close
            .Open
            .Write temp
        End If
        .SaveToFile path, 2
        .Close
    End With
End Sub

'ファイルに文字列を出力(追記モード)
Public Sub append(str() As String)
    Dim buf As String
    Dim temp() As Byte
    Dim i As Integer

    For i = 0 To UBound(str)
        If buf = "" Then
            buf = str(i)
        Else
            buf = buf + separator + str(i)
        End If
    Next i
    
    With obj
        .Open
        .LoadFromFile path
        .Position = .Size
        .WriteText buf, 0
        If Not bom Then
            .Position = 0
            .Type = 1
            .Position = 3
            temp = .read
            .Close
            .Open
            .Write temp
        End If
        .SaveToFile path, 2
        .Close
    End With
End Sub

使い方例(クラス名を”FileController”にした場合)

Sub test()
    Dim f As FileController
    Dim s() As String
    
    Set f = New FileController
    Call f.initialize("C:\Users\namek\test.txt", "UTF-8", vbCrLf, true)
    
    'ファイルの読み込み
    s = f.read
    
    'ファイルの書き込み
    Call f.out(s)
    
    'ファイルの書き込み(追記)
    Call f.append(s)
    
    Set f = Nothing
End Sub

使い方の解説

VBAだとconstractorに引数をもたせられないっぽいので、initializeという普通のメソッドを作りました。

クラスを作成した後に、このメソッドをまず呼び出します。

initializeでは引数を4つ指定します。

引数設定値
1読み込み/書き込みするのファイルパス
2文字コード
3改行文字(省略可能、デフォルトCRLF)
4BOM出力(省略可能、デフォルトあり)

Linax連携システムとかで改行文字を変えたかったり、UTF-8なのにBOMを出すなとかいう要望は結構多いのでオプションで追加しました。

メソッドは以下の3種類を用意しました。

メソッド名引数戻り値内容
readなし文字列型の配列ファイルを読み込んで、文字列型の配列に格納して返す
out文字列型の配列なし引数で渡した文字列型の配列をファイルに書き込む
(上書き)
append文字列型の配列なし引数で渡した文字列型の配列をファイルに書き込む
(追記)

1行ずつ読み込むことも出来るのですが、ぶっちゃけ配列を回せばいいだけなのとアクセス回数を減らせるので、配列で出し入れとしました。

あと「 1行ずつ読み込む 」と「全行読み込み」の両方を使うと、OPENとCLOSEの管理が面倒になり、かなりバグを誘発しそうです…。

クラスじゃない版

ファイルの競合とかを誘発しそうなのでクラス化しましたが、クラスを使用しないバージョンも作ってみました。

(あまりクラスを使わない文化のところも多そうなので)

以下のソースを標準モジュールに記載して、Publicな関数を呼び出して使います。

ソース

Private path As String
Private obj As Object
Private isOpen As Boolean
Private separator As String
Private bom As Boolean

Public Sub fileInitialize(filepath As String, _
                            charset As String, _
                            Optional fileseparator As String = vbCrLf, _
                            Optional bomflg As Boolean = true)
                            
    '引数からファイルのパスを貰ってフィールドに入れる
    path = filepath
    '引数から文字コードを貰ってフィールドに入れる
    Set obj = CreateObject("ADODB.Stream")
    obj.charset = charset
    separator = fileseparator
    bom = bomflg
    
    '後処理
    Dir (vbNullString)
End Sub

Public Sub fileTerminate()
    '後処理
    Set obj = Nothing
End Sub

'ファイルを読み込んで配列に格納
Public Function read() As String()
    Dim buf As String
    With obj
        .Open
        .LoadFromFile path
        buf = .ReadText
        .Close
    End With
    
    read = Split(buf, separator)
End Function

'ファイルに文字列を出力(新規作成モード)
Public Sub out(str() As String)
    Dim FSO As Object
    Dim buf As String
    Dim temp() As Byte
    Dim i As Integer
    
    'エラーになるので前のファイルを削除
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'FSO.DeleteFile path
    Set FSO = Nothing
    
    For i = 0 To UBound(str)
        If buf = "" Then
            buf = str(i)
        Else
            buf = buf + separator + str(i)
        End If
    Next i
    
    With obj
        .Open
        .LoadFromFile path
        .WriteText buf, 0
        If Not bom Then
            .Position = 0
            .Type = 1
            .Position = 3
            temp = .read
            .Close
            .Open
            .Write temp
        End If
        .SaveToFile path, 2
        .Close
    End With
End Sub

'ファイルに文字列を出力(追記モード)
Public Sub append(str() As String)
    Dim buf As String
    Dim temp() As Byte
    Dim i As Integer

    For i = 0 To UBound(str)
        If buf = "" Then
            buf = str(i)
        Else
            buf = buf + separator + str(i)
        End If
    Next i
    
    With obj
        .Open
        .LoadFromFile path
        .Position = .Size
        .WriteText buf, 0
        If Not bom Then
            .Position = 0
            .Type = 1
            .Position = 3
            temp = .read
            .Close
            .Open
            .Write temp
        End If
        .SaveToFile path, 2
        .Close
    End With
End Sub

使い方例

Sub test()
    Dim s() As String
    
    Call fileInitialize("C:\Users\namek\test.txt", "UTF-8", vbCrLf, True)
    
    'ファイルの読み込み
    s = read
    
    'ファイルの書き込み
    Call out(s)
    
    'ファイルの書き込み(追記)
    Call append(s)
    
    Call fileTerminate
End Sub

まあ、クラスバージョンとほぼ同じです。

最初に書きましたがクラス化しないと、複数のファイルを開いたりするときにオブジェクトの競合が起きるので要注意ですね。

(例)

  1. Aファイルを開く
  2. Bファイルを開く
  3. Aファイルに書き込む←オブジェクトがBで上書きされているので不可能

まあADOを入れるオブジェクトを連想配列とかにして管理すれば良さそうなのですが、面倒臭そうだったw


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)