【excel vba】 UTF-8 でテキストを入出力する

１．vbaエディタで「ツール → 参照設定」を開き、「Microsoft ActiveX Data Objects 2.8 Library」にチェックが入っていることを確認。

２．クラスモジュール
１）クラスモジュールを作成し、プロパティウィンドウからモジュール名を U8Stream とする。
２）以下のコードを貼りつける。

～～～～～～～～～

Option Explicit
'UTF-8 でテキストファイルを読込み・書き出し
' 参照設定で Microsoft ActiveX Data Objects x.x Library を選択のこと（x.x はバージョン番号）。
'
'使い方 ：
'１）読み込み
'Sub test_r()
'  Dim wStream As U8Stream, rx As Long
'
'  Set wStream = New U8Stream
'  wStream.U8SOpen "C:\UserFiles\U8STest.txt", Mode:="r"
'  rx = 1
'  For rx = 1 To 999
'    If (wStream.U8SEOS) Then Exit For
'    ActiveSheet.Cells(rx, 1).Value = wStream.U8SReadText
'  Next rx
'  wStream.U8SClose
'End Sub
'
'２）書き出し
'Sub test_w()
'  Dim wStream As U8Stream, endRow As Long, rx As Long
'
'  Set wStream = New U8Stream
'  endRow = ActiveCell.SpecialCells(xlLastCell).Row
'  wStream.U8SOpen "C:\UserFiles\U8STest_w.txt"
'  For rx = 1 To endRow
'    wStream.U8SWriteText ActiveSheet.Cells(rx, 1).Value
'  Next rx
'  wStream.U8SClose
'End Sub

Private pFNam As String
Private pStream As Object
Private pBOM As Boolean
Private pModeInput As Boolean

'ストリームを開く
Public Function U8SOpen(ByVal FNam As String, _
    Optional ByVal Mode As String = "w", _
    Optional ByVal BOM As Boolean = False, _
    Optional ByVal Charset As String = "UTF-8", _
    Optional ByVal LineSeparator As Integer = adCR) As Boolean
'  FNam         ： ファイル名
'  Mode         ： Read or Write （第一文字で判定；小文字可）
'  BOM          ： True = pBOM あり、False = なし（デフォルト）
'  Charset      ： 文字セットの名称
'  LineSeparator： 行区切り文字； CR .. 13, LF .. 10, CRLF .. -1
  U8SOpen = False
  pFNam = FNam:  pBOM = BOM
  pModeInput = (LCase(Left(Mode, 1)) <> "w")
  Set pStream = New ADODB.Stream
  'Initialize the stream
  With pStream
    .Open
    .Type = adTypeText
    .Position = 0
    .Charset = Charset
    .LineSeparator = LineSeparator
  End With
  If (pModeInput) Then
    pStream.LoadFromFile (pFNam)
  End If
  U8SOpen = True
End Function

'ストリームからテキストを行単位で入力
Public Function U8SReadText() As Variant
  U8SReadText = False
  If (Not (pModeInput)) Then
    Err.Raise Number:=9990, Description:="書き出しストリームとして開かれています。"
  End If
  If (Not (pStream.EOS)) Then
    U8SReadText = pStream.ReadText(adReadLine)
  End If
End Function

'ストリームの終了をチェック
Public Function U8SEOS() As Boolean
  U8SEOS = pStream.EOS
End Function

'ストリームにテキストを出力
Public Function U8SWriteText(aStr As String) As Boolean
  U8SWriteText = False
  If (pModeInput) Then
    Err.Raise Number:=9991, Description:="読み込みストリームとして開かれています。"
  End If
  pStream.WriteText aStr, adWriteLine   'supply line sep.
  U8SWriteText = True
End Function

'ストリームを解放
Public Function U8SClose() As Boolean
  '出力モードではストリームをファイルに上書きで保存する。
  U8SClose = False
  If (pModeInput) Then
    'for Read mode .. nothing to do here.
  Else
  'for Write mode ..
    'ストリームをファイルに保存し、解放する
    If (Not pBOM) Then    'delete BOM
      Dim byteData() As Byte
      With pStream
        .Position = 0
        .Type = adTypeBinary
        .Position = 3
        byteData = pStream.Read
        .Close
        .Open
        .Write byteData
      End With
    End If
    pStream.SaveToFile pFNam, adSaveCreateOverWrite
  End If
  Set pStream = Nothing
  U8SClose = True
End Function

～～～～～～～～～