[VBA]テキストファイルを読み込み/書き込みする「ADODB.Stream」の使い方

[0]はじめに

Zitanです。
Qiitaの記事をもっと効率的に書けないかなーと思って「ADODB.Stream」というものを調べてみました。
いろいろ検討中ですが、何かに役立ちそうなのでご紹介します。
一番下に今回のコード全文がありますので結論だけ欲しい人は一番下へどうぞ。
もしくはこちら(Git Hub)

[1]ADO(ActiveX Data Objects)とは

テキストファイルの操作をしたいときに活躍します。
他、テキストファイルとExcelファイル、CSV、XMLを相互に操作するとき、文字コードが重要になってきます。
文字コードがUTF-8でないと文字化けを起こすので、これを使って事前にUTF-8に変換します。
~~自分自身よく理解していないので、~~説明が難しいので実際に使ってみましょう。
今回は、読み取ったテキストファイルを別のテキストファイルに書き込むところまでを行います。

参照設定から使う場合は、メソッドを入力補完してくれるので便利です。
「Microsoft ActiveX Data Objects XXX Library」※XXXはバージョンなので最新版を選んで下さい。
皆がマクロに詳しいわけではないので、参照設定されていないブックの場合を想定して
今回は、CreateObject("ADODB.Stream")でコーディングしています。

[2]ダイアログボックスからテキストファイルを選択してテキスト全文をString変数textに格納します。

まずはコード全文です。
挙動はコードの下のGIF動画をご覧下さい。

指定したテキストファイルの中身をString型の変数に格納する

Option Explicit

Dim OpenFile  As Variant
Dim text As String

Sub テキストファイルを読み込む()

ダイアログボックスからファイルを選択するとファイルが格納される。キャンセルするとフラグ(False)が返される
OpenFile = Application.GetOpenFilename("テキストファイル (*.txt),*.txt")

If OpenFile = False Then
    MsgBox "キャンセルしました。"
    Exit Sub
End If

テキストファイル内の全文をString型の変数に格納
text = ReadFileText(OpenFile)

'結果をイミディエイトウインドウに表示する
Debug.Print text

End Sub

テキストファイルの文字コードをUTF-8に設定してから読み込む
Function ReadFileText(ByVal FilePath As String) As String
    Dim AD As Object: Set AD = CreateObject("ADODB.Stream")
    AD.Charset = "utf-8"
    AD.Open
    AD.LoadFromFile FilePath
    ReadFileText = AD.ReadText
    AD.Close
End Function

[3]別名の新しいテキストファイルに書き込みする

まずはコード全文です。
挙動はコードの下のGIF動画をご覧下さい。

先ほど読み込んだテキスト全文を別名ファイルに書き込んで保存する(先ほどのコードの続きです)

Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TempTextFile As Variant
TempTextFile = ThisWorkbook.Path & "\tmpQiita_.txt"
既に同名のファイルがあったら削除する(エラー回避)
    If FSO.FileExists(TempTextFile) = True Then
        FSO.GetFile(TempTextFile).Delete
    End If
このブックと同じ階層に、tmpQiita_.txtというファイルを作成する
この時点では空のテキストファイルです。
FSO.CreateTextFile TempTextFile
新しいファイル「tmpQiita_.txt」に先ほど読み込んだtextを書き込んで上書き保存します。
Call WriteFileText(text & "「これが新しくできたファイル」", TempTextFile)
Set FSO = Nothing
先ほどのコードとつなげるときは、下の「End Sub」は消して下さい。
End Sub

テキストファイルの文字コードをUTF-8に設定してから書きこむ
Function WriteFileText(ByVal text As String, ByVal TempTextFile As String)
    Dim AD As Object: Set AD = CreateObject("ADODB.Stream")
    AD.Charset = "utf-8"
    2はテキストファイル
    AD.Type = 2
    AD.Open
    AD.WriteText text
    2は上書き保存
    AD.SaveToFile (TempTextFile), 2
    AD.Close
End Function

[4]コード全文

コメント等を消したコード全文です。

必要に応じてカスタマイズして下さい。

Option Explicit

Dim OpenFile  As Variant
Dim text As String

Sub ADOTEST()
OpenFile = Application.GetOpenFilename("テキストファイル (*.txt),*.txt")
If OpenFile = False Then
  MsgBox "キャンセルしました。"
  Exit Sub
End If
text = ReadFileText(OpenFile)



Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TempTextFile As Variant
TempTextFile = ThisWorkbook.Path & "\tmpQiita_.txt"
  If FSO.FileExists(TempTextFile) = True Then
     FSO.GetFile(TempTextFile).Delete
  End If
FSO.CreateTextFile TempTextFile
Call WriteFileText(text & "「これが新しくできたファイル」", TempTextFile)
Set FSO = Nothing

End Sub


Function ReadFileText(ByVal FilePath As String) As String
  Dim AD As Object: Set AD = CreateObject("ADODB.Stream")
  AD.Charset = "utf-8"
  AD.Open
  AD.LoadFromFile FilePath
  ReadFileText = AD.ReadText
  AD.Close
End Function

Function WriteFileText(ByVal text As String, ByVal TempTextFile As String)
  Dim AD As Object: Set AD = CreateObject("ADODB.Stream")
  AD.Charset = "utf-8"
  AD.Type = 2
  AD.Open
  AD.WriteText text
  AD.SaveToFile (TempTextFile), 2
  AD.Close
End Function

[5]まとめ

いかがでしょうか。
読み取ったテキストに何か処理を加えて別のファイルに書き出すといったことに応用ができます。
使いようによっては結構重宝するのではないかと思います。