[VBA]文字コードを指定してファイルにテキストを出力するクラスモジュール

[はじめに]
・最近、JSONファイルを扱うことがあり、
　UTF-8でテキストファイルを作成する機会があったので、
　作ってみました。
　備忘録としてサンプルを掲載します。
　クラスモジュールで定義することを前提としています。

[ソース]

''' <summary> ''' クラスモジュール名：TextWriterWithCharaSet ''' 文字コードを指定してファイルにテキストを出力するクラス ''' </summary> ''' <remarks></remarks> Option Explicit 'ファイルのバッファサイズ Private Const BUF_SIZE As Integer = 1024 '文字コード（デフォルト：UTF-8） Public CharCode As String '出力ディレクトリ Public TargetDirectory As String '出力ファイル名 Public TargetFileName As String 'FileSystemObject Private objFs As Object 'ADODB.Stream Private objStream As Object 'ADODB.StreamのSaveOptionsEnum Private Enum SaveOptionsEnum     'ファイルが存在しない場合にのみ作成します。     '存在する場合はエラー。（既定値）     adSaveCreateNotExist = 1     'ファイルが存在する場合は、     'ファイルを上書きします。     adSaveCreateOverWrite = 2 End Enum '出力テキストのコレクション Private colTraget As New Collection ''' <summary> ''' Initializeイベント（コンストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Initialize()     Set objStream = CreateObject("ADODB.Stream")     Set objFs = CreateObject("Scripting.FileSystemObject")          Me.CharCode = "UTF-8"          Call ClearBuffer End Sub ''' <summary> ''' Terminateイベント（デストラクタ） ''' </summary> ''' <remarks></remarks> Private Sub Class_Terminate()           Call Flush          Set objStream = Nothing     Set objFs = Nothing End Sub ''' <summary> ''' テキストを出力する。 ''' </summary> ''' <param name="strText">出力テキスト</param> ''' <param name="useBuffer">バッファの利用有無（※省略時はTrue）</param> ''' <remarks></remarks> Public Sub WriteText( _     ByVal strText As String, _     Optional ByVal useBuffer As Boolean = True)          colTraget.Add strText          If useBuffer = True Then         'バッファ有効の場合は、         '一旦、バッファに溜めておき、         '特定サイズを越えてからファイル出力する。         If colTraget.Count > BUF_SIZE Then             Me.Flush         End If     Else         'バッファ無効の場合は、ファイルに出力         Me.Flush     End If End Sub ''' <summary> ''' バッファーの内容をテキストに出力する。 ''' </summary> ''' <remarks></remarks> Public Sub Flush()           Dim i As Long     Dim targetFilePath As String          On Error GoTo LBL_ERR:           'ファイルパスを生成     targetFilePath = objFs.BuildPath( _         GetTargetDirectory(), TargetFileName)          With objStream         .Charset = Me.CharCode         .Open                  'ファイルが既に存在する場合は、全テキストを読込む。         '※追記書込みができないので、         '  既存テキストをメモリ上に取込んでから上書きする。         If objFs.FileExists(targetFilePath) Then             .LoadFromFile targetFilePath             .Position = .Size         End If         For i = 1 To colTraget.Count             .WriteText colTraget(i)         Next                  .SaveToFile targetFilePath, _             SaveOptionsEnum.adSaveCreateOverWrite                  .Close          End With           Call ClearBuffer          Exit Sub LBL_ERR:           Call ClearBuffer            Err.Raise _          Number:=Err.Number, _          Description:="テキストの出力に失敗しました。" & _          Err.Description End Sub ''' <summary> ''' 出力ディレクトリを取得する。 ''' </summary> ''' <returns>出力ディレクトリ（デフォルト：ThisWorkbook.path）</returns> ''' <remarks></remarks> Private Function GetTargetDirectory() As String      If Me.TargetDirectory = "" Then          GetTargetDirectory = ThisWorkbook.path          Exit Function      End If      GetTargetDirectory = Me.TargetDirectory End Function ''' <summary> ''' 出力ファイルパスを設定する。 ''' </summary> ''' <param name="targetFilePath">出力ファイルパス</param> ''' <remarks></remarks> Public Sub SetFilePath(ByVal targetFilePath As String)           With objFs         Me.TargetDirectory = _             .GetParentFolderName(targetFilePath)         Me.TargetFileName = _             objFs.GetFileName(targetFilePath)     End With End Sub ''' <summary> ''' バッファーをクリアする。 ''' </summary> ''' <remarks></remarks> Public Sub ClearBuffer()      Dim i As Long            For i = colTraget.Count To 1 Step -1          colTraget.Remove i      Next End Sub

[VBA]文字コードを指定してファイルにテキストを出力するクラスモジュール

[ソース]

Private Sub CommandButton1_Click()     Dim rw As New TextWriterWithCharaSet          rw.CharCode = "UTF-8"     rw.SetFilePath "C:\aaa\hogehoge.txt"     rw.WriteText "ABCDE", True          Set rw = Nothing      End Sub

[VBA]使用例