Shift-JIS のテキストファイルを UTF-8 のテキストファイルに文字コードを変換して保存する。 (ADODB.Stream オブジェクトを使用した場合のサンプル)
試し方
- Try_To_Run_This_Macro を実行すると、ファイルを開くダイアログが現れます。
- 変換したいテキストファイルを選択してOKを押す。
- 変換されたファイルが utf_8_file.txt という名前で保存される。
さらに... サンプルコードの SecondObj の Charset プロパティを変更することによって utf-8以外にも euc-jp,euc-kr,utf-7...等々にも変換できる。※システムが認識できる文字セット文字列の一覧については、Windows レジストリの HKEY_CLASSES_ROOT\MIME\Database\Charset のサブキーを参照。
■サンプルコードの前半の半分以上がファイルを開くダイアログを表示するwindows APIの宣言です。こちらもご自由に利用ください。
'............................................................... ' '■引数 pOpenfilename:OPENFILENAME構造体 '■戻り値 OKボタンを押した時1、キャンセルボタンを押した時0 ' '............................................................... Public Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long 'OPENFILENAME構造体 Public Type OPENFILENAME lStructSize As Long '構造体のサイズ hwndOwner As Long 'ウインドウのハンドル hInstance As Long 'インスタンスハンドル lpstrFilter As String 'フィルター lpstrCustomFilter As String 'カスタムフィルター nMaxCustFilter As Long 'カスタムフィルターのサイズ nFilterIndex As Long 'フィルタのインデックス lpstrFile As String 'ファイル名のバッファ nMaxFile As Long 'ファイル名のバッファのサイズ lpstrFileTitle As String 'フルパス用のバッファ nMaxFileTitle As Long 'フルパス用のバッファのサイズ lpstrInitialDir As String 'ディレクトリを指定 lpstrTitle As String 'ダイヤログボックスのタイトル flags As Long '定数（OFN＿××参照） nFileOffset As Integer 'フルパスの中のファイル名までのオフセット nFileExtension As Integer '拡張子までのオフセット lpstrDefExt As String 'デフォルトの拡張子 lCustData As Long 'lpfnHookで渡すデータ lpfnHook As Long 'フック関数のポインタ lpTemplateName As String 'テンプレート名 End Type Public Const OFN_ALLOWMULTISELECT = &H200 '複数ファイルを選択可能にする Public Const OFN_CREATEPROMPT = &H2000 '指定のファイル名が存在しない時にメッセージボックスを表示 Public Const OFN_FILEMUSTEXIST = &H1000 '存在しないファイル名は入力不可 Public Const OFN_HIDEREADONLY = &H4 '読み取り専用のチェックボックスを非表示 Public Const OFN_NOCHANGEDIR = &H8 '他のサブディレクトリから選択不可 Public Const OFN_NOREADONLYRETURN = &H8000 '読み込み専用ファイルと書きこみ禁止ディレクトリの選択不可 Public Const OFN_NOVALIDATE = &H100 'ファイル名の有効性をチェックしない Public Const OFN_OVERWRITEPROMPT = &H2 '既存のファイル名を指定した時にメッセージを出す Public Const OFN_PATHMUSTEXIST = &H800 '有効なパスだけをうけつける Public Const OFN_READONLY = &H1 '読み取り専用のチェックボックスをチェック Public Const OFN_SHOWHELP = &H10 'ヘルプボタンを表示 '............................................................... '............................................................... '■関数名 OpenDlg ラッパ関数 '■用途 「ファイルを開く」コモンダイヤログを表示する '■引数 nHandle：ウインドウのハンドル ' nFilter：フィルター ' InitialDir :デフォルトのディレクトリ '■戻り値 ファイルを選択した場合そのファイルのパス名、 ' キャンセルを押した場合""が戻る '............................................................... Private Function OpenDlg(ByVal nFilter As String, ByVal InitialDir As String) As String Dim OFN As OPENFILENAME 'OPENFILENAME構造体 Dim Ret As Long '戻り値 With OFN '構造体の設定 .flags = OFN_PATHMUSTEXIST Or _ OFN_FILEMUSTEXIST Or _ OFN_HIDEREADONLY 'Or OFN_SHOWHELP .hInstance = hInstance 'Application.hInstance 'インスタンスハンドルを設定 .hwndOwner = 0 'ウインドウハンドルを設定 .lpstrTitle = "ファイルを開く" 'コモンダイアログのタイトルを設定 .lpstrFilter = nFilter 'フィルターを設定 .lStructSize = Len(OFN) '構造体のサイズを設定 .nMaxFile = 1024 'ファイル名のバッファのサイズを設定 .lpstrFileTitle = String(1024, Chr(0)) 'フルパス用のバッファを確保 .nMaxFileTitle = 1024 'フルパス用のバッファのサイズを設定 .lpstrFile = String(1024, Chr(0)) 'ファイル名のバッファを確保 .lpstrInitialDir = InitialDir 'デフォルトのディレクトリを指定 End With Ret = GetOpenFileName(OFN) If Ret = 0 Then 'キャンセルを押した時の処理 OpenDlg = vbNullString Else 'OK押した時の処理 OpenDlg = Replace(OFN.lpstrFile, vbNullChar, "") End If End Function '............................................................... Public Function Show_FileDialog() As String '............................................................... 'Show_FileDialog() As Variant ' この関数の目的: ' ファイルを開くダイアログボックスを表示して ' ファイルの選択をする。 '............................................................... Dim Filename As String Dim Filter As String Dim InitialDirectory As String Filter = "テキストファイル(*.txt)" & vbNullChar & "*.txt" _ & vbNullChar & "全てのファイル(*.*)" & _ vbNullChar & "*.*" InitialDirectory = "d:\" Filename = OpenDlg(Filter, InitialDirectory) If Filename = vbNullString Then MsgBox "キャンセルが押されました。" _ & vbCrLf & _ "このマクロを終了します。" End Else Show_FileDialog = Filename End If End Function '■■■■■■■■■■■■■■■■■■ 'ここからが文字コード変換マクロ '■■■■■■■■■■■■■■■■■■ Sub Try_To_Run_This_Macro() ShiftJis_to_utf8 (Show_FileDialog()) End Sub Public Sub ShiftJis_to_utf8(Filename As String) Dim FirstObj As Object Dim SecondObj As Object Set FirstObj = CreateObject("ADODB.Stream") With FirstObj .Type = 2 .Charset = "shift-jis" .Open .LoadFromFile Filename .Position = 0 End With Set SecondObj = CreateObject("ADODB.Stream") With SecondObj .Type = 2 .Charset = "utf-8" .Open End With FirstObj.copyto SecondObj SecondObj.Position = 0 SecondObj.savetofile "utf_8_file.txt", 2 End Sub
