Excel VBAでUTF-8形式 HTMLファイルの読み込みと書き込み方法

Excel VBAでUTF－8形式のファイルを読み書きするには、ADODB.Streamを使用します。ここでは一気にまとめて読み込む方法と1行ずつ読み込む方法、そしてファイルに保存する方法を掲載します。

UTF-8形式のHTMLファイルをテキスト形式で読み込みテスト

以前に掲載した「テキストファイルの読込み」のコードを使用し読み込んでみます。


'テキストファイルの読込み
Private Sub ExTxtRead()
     Dim fn As Long
     Dim tmp As String
     Dim fname As String
     Dim buf As String
     
    fname = "c:\test\index.html"
    fn = FreeFile
    Open fname For Input As #fn
         Do Until EOF(fn)
            Line Input #fn, tmp
            buf = buf & tmp
         Loop
     Close #fn
     MsgBox buf
 End Sub

下のように日本語部分が文字化けしています。
やはりテキスト形式の読み込みではダメなようです。

UTF-8形式のHTMLファイルをまとめて読み込む

下のようなVBAになります。

• CreateObjectでADODB.Streamをオブジェクトとして参照します。
• Charset = "UTF-8"で文字コードを設定します。
• LineSeparatorで改行コードをLFに設定しています。
  CRの場合は13、CRLFの場合は-1になります。
• OpenでADODB.Streamを開き、ReadTextで読み込みます。
• CloseでADODB.Streamを閉じます。

'UTF-8ファイルの読込み
Private Sub a1ExUtfRead()
    Dim buf As String
    Dim fname As String
    Dim tobj As Object
    
    fname = "c:\test\index.html"
    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.LineSeparator = 10
    tobj.Open
    tobj.LoadFromFile fname
    buf = tobj.ReadText
    tobj.Close
    MsgBox buf
End Sub

結果、下のように日本語が文字化けせずに正常に読み込まれています。

UTF-8形式のHTMLファイルを1行ずつ読み込む

下のようなVBAになります。
CSVで保存する場合は、この方法で出力します。

• EOS(End Of Stream)は、テキストで使用したEOF(End Of File)と同じでストリームの終わりを調べています。
• ReadTextの引数に-2を指定すると、1行ずつ読み込みます。
• ここでは1行ずつ読み込まれているか確認するため、行の先頭に＊を付けています。

'UTF-8ファイルの読込み
Private Sub a2ExUtfRead()
    Dim buf As String
    Dim fname As String
    Dim tobj As Object
    
    fname = "c:\test\index.html"
    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.LineSeparator = 10
    tobj.Open
    tobj.LoadFromFile fname
         Do Until tobj.EOS
            tmp = tobj.ReadText(-2)
            buf = buf & "＊" & tmp
         Loop
    tobj.Close
    MsgBox buf
End Sub

結果、各行の先頭に＊が付いているので間違いなく1行ずつ読み込まれています。

UTF-8形式のHTMLファイルを書き込む

下のようなVBAになります。

• 1行ずつ読み込み、3行目に<TEST>の文字列を挿入します。
• 開いたファイルを閉じ、別名のファイルを開きます。ファイルがない場合は新規作成されます。
• ストリームに上で読み込まれた文字列を書き込みます。
• SaveToFile fnameでストリームをファイルに保存します。
  引数が1の場合、ファイルが存在する場合エラーになり、無い場合は新規作成されます。
  引数が2の場合、ファイルが存在する場合上書きし、無い場合は新規作成されます。

'UTF-8ファイルの読込み
Private Sub ExUtfSave()
    Dim buf As String
    Dim fname As String
    Dim tobj As Object
    Dim i As Long
    
    fname = "c:\test\index.html"
    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.LineSeparator = 10
    tobj.Open
    tobj.LoadFromFile fname
         Do Until tobj.EOS
            tmp = tobj.ReadText(-2)
            buf = buf & tmp
            i = i + 1
            If i = 2 Then
                buf = buf & "<TEST>" & vbLf
            End If
         Loop
    tobj.Close
    MsgBox buf

    fname = "c:\test\index2.html"
    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.LineSeparator = 10
    tobj.Open
    tobj.WriteText buf
    tobj.SaveToFile fname, 2
    tobj.Close
End Sub

結果下のように、3行目に<TEST>の文字列が挿入され、正常に書き込みできました。