ExcelVBAマクロについて確認させてください。

質問

ExcelVBAマクロについて確認させてください。
テキストファイル内の全ての文字を読み込むプログラムですが、テキストファイルがUTF-8形式の場合は文字化けしてしまいます。
UTF-8形式の場合でも読み込める方法はありますでしょうか。
お手数おかけしますが、よろしくお願いします。

Sub test()
Dim FSO As Object, buf As String
Set FSO = CreateObject("Scripting.FileSystemObject")
''C:\Work\Sample.txtの全ての文字を読み込んで表示します
With FSO.GetFile("C:\Work\Sample.txt").OpenAsTextStream
buf = .ReadAll
MsgBox buf
.Close
End With
Set FSO = Nothing
End Sub

回答No.3

HohoPapa

>UTF-8形式の場合でも読み込める方法
予めCharsetを調べ、
ADODB.Streamオブジェクトを使う対応になりましょう。

以下、サンプルです。

'Microsoft ActiveX Data Objects x.x Libraryを参照設定
Sub Sample5()

　Dim Target As String
　Dim judgeCode As String
　Dim adoSt As Object
　Dim MyText As String

　'ADODB.Streamオブジェクトを生成
　Set adoSt = CreateObject("ADODB.Stream")

　'テキストファイルを選ぶ
　Target = Application.GetOpenFilename("テキストファイル,*.*")
　If Target = "False" Then Exit Sub

　'ファイルのCharsetを調べる
　judgeCode = GetCharset(Target)

　With adoSt
　　.Charset = judgeCode　　　　'Streamで扱う文字コートを設定
　　.Open　　　　　　　　　　　 'Streamをオープン
　　.LoadFromFile (Target)　　　'ファイルからStreamに読み込む
　　MyText = .Readtext(adReadAll)
　　'Debug.Print MyText
　　MsgBox (MyText)
　　.Close
　End With

End Sub

'ファイルを調べCharsetを取得　引数：ファイル名フルパス
Function GetCharset(strFileName As String) As String
　Dim buf(2) As Byte
　Dim intFileNo As Integer
　intFileNo = FreeFile
　Open strFileName For Binary Access Read As intFileNo
　Get intFileNo, , buf
　Close intFileNo
　If (buf(0) = 255) And (buf(1) = 254) Then
　　GetCharset = "unicode"
　ElseIf (buf(0) = 239) And (buf(1) = 187) And (buf(2) = 191) Then
　　GetCharset = "utf-8"
　Else
　　GetCharset = "shift-jis"
　End If
End Function

回答No.2

imogasi

ここに質問する前に、ＷＥＢ照会して、
http://neos21.hatenablog.com/entry/2016/03/25/074343
を読んででみたら。
＞
CreateTextFileの第3引数をtrueにするとUTF-16でファイルを作る。falseにするとShift_JIS。UTF-8で作ることはできない。UTF-8で作りたいときはFileSystemObjectではなくADODB.Streamを使う。
それでも
「このやり方だと「BOM 付き UTF-8」になる」
そこで、
https://k-sugi.sakura.ne.jp/windows/vb/3650／に解説が続く。

回答No.1

f272

こんな感じ？
Sub test()
Dim buf As String
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile "C:\Work\Sample.txt"
buf = .ReadText
MsgBox buf
.Close
End With
End Sub