「Option Explicit」マジ大事。適当に書いても動くからVBA厄介デスヨネー。
UTF-8はBOM有で、UTF-8NはBOM無し。
本題。UTF-8はADODBを使って入出力します。FSOもついでに載せときます。
Option Explicit Public Sub テキストファイルUTF8読み込み(strFilePath As String) Dim buf As String, temp As Variant Dim iRow As Long, iClm As Long Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("読込結果") '違う文字コードのファイルを読み込むとエラーとなるので必ず回避。 '回避先でCloseを忘れない。 On Error GoTo err_1 With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile strFilePath Do Until .EOS 'EOFと同義 buf = .ReadText(-2) '1行ずつ読み込みは-2、全て読み込みは-1又は引数無し iRow = iRow + 1 temp = Split(buf, vbTab) 'タブ区切り For iClm = LBound(temp) To UBound(temp) ws.Cells(iRow, iClm + 1) = temp(iClm) Next Loop err_1: .Close End With Set ws = Nothing End Sub Public Sub テキストファイル読み込みFSO(strFilePath As String) Dim buf As String, temp As Variant, lineTemp As Variant Dim iRow As Long, iClm As Long Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("読込結果") With CreateObject("Scripting.FileSystemObject") With .GetFile(strFilePath).OpenAsTextStream buf = .ReadAll '全て読み込む .Close End With End With lineTemp = Split(buf, vbCrLf) '改行で区切る For iRow = LBound(lineTemp) To UBound(lineTemp) temp = Split(lineTemp(iRow), vbTab) 'タブ区切り For iClm = LBound(temp) To UBound(temp) ws.Cells(iRow + 1, iClm + 1) = temp(iClm) Next Next Set ws = Nothing End Sub Public Sub テキストファイル書き出しFSO() Dim strFilePath As String Dim buf As String Dim delimiter As String Dim row As Range, clm As Range Dim ws As Worksheet Dim fso As Object strFilePath = Application.GetSaveAsFilename(InitialFileName:="shift-jis.txt", _ FileFilter:="テキストファイル(*.txt),*txt,CSVファイル(*.csv),*.csv") If strFilePath = "False" Then Exit Sub Set fso = CreateObject("Scripting.FileSystemObject") Set ws = ThisWorkbook.Worksheets("読込結果") delimiter = vbTab 'タブ区切り With fso.CreateTextFile(strFilePath) For Each row In ws.UsedRange.Rows buf = "" For Each clm In row.Columns buf = buf & clm.Value If clm.Column < row.Columns(row.Columns.Count).Column Then buf = buf & delimiter '最後の列でなければ区切り文字を追加 End If Next .WriteLine buf Next .Close End With Set ws = Nothing Set fso = Nothing End Sub Public Sub テキストファイル書き出しADODB(Optional bom As Boolean = True) Dim ws As Worksheet Dim strFilePath As String Dim buf As String Dim delimiter As String Dim row As Range, clm As Range strFilePath = Application.GetSaveAsFilename(InitialFileName:="utf-8.txt", _ FileFilter:="テキストファイル(*.txt),*txt,CSVファイル(*.csv),*.csv") If strFilePath = "False" Then Exit Sub Set ws = ThisWorkbook.Worksheets("読込結果") delimiter = vbTab 'タブ区切り With CreateObject("ADODB.Stream") .Charset = "UTF-8" .LineSeparator = -1 '-1:adCRLF, 10:adLF, 13:adCR .Open For Each row In ws.UsedRange.Rows buf = "" For Each clm In row.Columns buf = buf & clm.Value If clm.Column < row.Columns(row.Columns.Count).Column Then buf = buf & delimiter '最後の列でなければ区切り文字を追加 End If Next .WriteText buf, 1 '0:adWriteChar, 1:adWriteLine Next If Not bom Then 'UTF-8N（UTF-8 BOM無し）を出力する Dim byteData() As Byte .Position = 0 .Type = 1 '1:adTypeBinary(バイナリ), 2:adTypeText(既定値、テキスト) .Position = 3 '先頭3Byte(BOM)を回避 byteData = .Read '書き込み予定データを一時避難 .Position = 0 .Write byteData '一時避難データを再設定 .SetEOS '終了個所を再設定 .SaveToFile strFilePath, 2 '1:adSaveCreateNotExist(既定値、新規作成), 2:adSaveCreateOverWrite(上書保存) .Close Else 'BOM有のUTF-8を出力する .SaveToFile strFilePath, 2 .Close End If End With Set ws = Nothing End Sub
