https://www.ka-net.org/blog/?p=4479
https://vbabeginner.net/convert-shift-jis-files-to-utf-8-without-bom/
-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
Option Explicit
Private Sub CommandButton1_Click()
'画面を更新しない
Application.ScreenUpdating = False
'確認メッセージを表示しない
Application.DisplayAlerts = False
'(1)テストファイル作成
Open ThisWorkbook.Path & "\test1.txt" For Output As #1
Print #1, "テストファイルです1"
Print #1, "テストファイルです2"
Close #1
'(2)SJIS -> UTF8
Call SjisToUtf8NoBOM(ThisWorkbook.Path & "\test1.txt", ThisWorkbook.Path & "\test2.txt")
'(3)Base64エンコード
Dim buf As String
buf = EncodeBase64(ThisWorkbook.Path & "\test2.txt")
Debug.Print buf
Open ThisWorkbook.Path & "\buf.txt" For Output As #1
Print #1, buf
Close #1
'(4) Base64デコード
DecodeBase64 buf, ThisWorkbook.Path & "\test3.txt"
'(5)UTF8 -> SJIS
Call Utf8ToSjis(ThisWorkbook.Path & "\test3.txt", ThisWorkbook.Path & "\test4.txt")
'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True
End Sub
'ファイルをBase64エンコード
Function EncodeBase64(ByVal FilePath As String) As String
Const adTypeBinary = 1
Const adReadAll = -1
Dim elm As Object
Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
Dim Base64Str As String
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.LoadFromFile FilePath
elm.DataType = "bin.base64"
elm.nodeTypedValue = .Read(adReadAll)
Base64Str = elm.text
End With
EncodeBase64 = Replace(Base64Str, vbLf, "")
End Function
'ファイルをBase64デコード
Sub DecodeBase64(ByVal Base64Str As String, ByVal FilePath As String)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim elm As Object
Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
elm.DataType = "bin.base64"
elm.text = Base64Str
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.Write elm.nodeTypedValue
.SaveToFile FilePath, adSaveCreateOverWrite
End With
End Sub
'SJIS -> UTF8
Sub SjisToUtf8NoBOM(ByVal a_sFrom As String, ByVal a_sTo As String)
Dim sText As Variant '// ファイルデータ
Dim streamRead As Object '// 読み込みデータ
Dim streamWrite As Object '// 書き込みデータ
Set streamRead = CreateObject("ADODB.Stream")
Set streamWrite = CreateObject("ADODB.Stream")
'// ファイル読み込み
With streamRead
.Type = 2 'adTypeText
.Charset = "Shift-JIS"
.Open
.LoadFromFile a_sFrom
sText = .ReadText
''// 改行コードCRLFをLFに変換
'' sText = Replace(sText, vbCrLf, vbLf)
End With
'// ファイル書き込み
With streamWrite
.Type = 2 'adTypeText
.Charset = "UTF-8"
.Open
'// Shift-JISファイルのデータをUTF-8ファイルにコピー
.WriteText sText
'// バイナリモードで書き込み済みデータ開始位置をBOM分の3バイトずらす
.Position = 0
.Type = 1 'adTypeBinary
.Position = 3
'// 3バイトずらした状態でのデータを取得
sText = .Read
'// ずらした開始位置を元に戻す
.Position = 0
'// BOMが除去されたデータを先頭から書き込み直す
.Write sText
'// 現時点の末尾を終端とし、直前に書き込まれていた3バイトをデータ対象外とする
.SetEOS
'// 保存
.SaveToFile a_sTo, 2 'adSaveCreateOverWrite
End With
End Sub
'UTF8 -> SJIS
Sub Utf8ToSjis(ByVal a_sFrom As String, ByVal a_sTo As String)
Dim sText As Variant '// ファイルデータ
Dim streamRead As Object '// 読み込みデータ
Dim streamWrite As Object '// 書き込みデータ
Set streamRead = CreateObject("ADODB.Stream")
Set streamWrite = CreateObject("ADODB.Stream")
'// ファイル読み込み
With streamRead
.Type = 2 'adTypeText
.Charset = "UTF-8"
.Open
.LoadFromFile a_sFrom
sText = .ReadText
''// 改行コードLFをCRLFに変換
'' sText = Replace(sText, vbLf, vbCrLf)
'' sText = Replace(sText, vbCr & vbCr, vbCr)
End With
'// ファイル書き込み
With streamWrite
.Type = 2 'adTypeText
.Charset = "Shift-JIS"
.Open
'// データ書き込み
.WriteText sText
'// 保存
.SaveToFile a_sTo, 2 'adSaveCreateOverWrite
End With
End Sub
