У меня есть macro
для преобразования oracle SQL
файла в файл postgresql, и макрос работает нормально. поскольку все файлы SQL
сохраняются в кодировке Shift-JIS
, но теперь я хочу, чтобы этот макрос был расширен для преобразования всех кодированных файлов Shift-JIS
в кодировку UTF-8
. Я пытался разными способами добиться преобразования кодировки, но не смог. не знаю, где правильно изменить.
'
' 機能: DDL変換ボタンクリック時のイベント
'
' 返り値: なし
'
' 機能説明: 入力フォルダ内のフォルダおよびファイルを出力フォルダにすべてコピーする。
' コピーしたファイル内容をPostgreSQLの構文に変換する。
'
' 備考: 入力ファイルはOracleのDDLファイルのみ対応
'
Sub DDL変換_Click()
'// 入力フォルダパスを取得
Dim strIN_PATH As String
strIN_PATH = Range("C2").Value
strIN_PATH = strIN_PATH & "\"
strIN_PATH = Replace(strIN_PATH, "\\", "\", , , vbBinaryCompare)
' Debug.Print (strIN_PATH)
'// 出力フォルダパスを取得
Dim strOUT_PATH As String
strOUT_PATH = Range("C3").Value
strOUT_PATH = strOUT_PATH & "\"
strOUT_PATH = Replace(strOUT_PATH, "\\", "\", , , vbBinaryCompare)
' Debug.Print (strOUT_PATH)
'// 出力フォルダ内のフォルダをすべて削除
Dim objFSO As New FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder strOUT_PATH & "*"
'// 出力フォルダ内のファイルをすべて削除
Call objFSO.DeleteFile(strOUT_PATH & "*", True) ' 指定したパスのファイルを削除
'// 入力フォルダのファイルを出力フォルダへコピー
objFSO.GetFolder(strIN_PATH).Copy Replace(strOUT_PATH & "\", "\\", "", , , vbBinaryCompare)
'// ファイルオブジェクトを初期化
Set objFSO = Nothing
'// 出力フォルダのファイルをすべて変換
Call replaceFromFolder(strOUT_PATH)
'// 処理完了のメッセージを表示
MsgBox "入力ファイルのPostgreSQLへのDDL変換が完了しました。" & vbCrLf & "出力フォルダを確認してください。", vbOKOnly, "DDL変換"
End Sub
'
' 機能: 指定フォルダのファイルをすべてをPostgreSQLの構文に変換する。
'
' 返り値: なし
'
' 機能説明: 引数に指定したフォルダのファイルをすべてをPostgreSQLの構文に変換する。
'
' 備考: 例外処理などはなし
'
Sub replaceFromFolder(searchPath)
Dim FSO As New FileSystemObject
Dim objFiles As File
Dim objFolders As Folder
Dim separateNum As Long
'サブフォルダ取得
For Each objFolders In FSO.GetFolder(searchPath).SubFolders
Call replaceFromFolder(objFolders.Path)
Next
'ファイル名の取得
For Each objFiles In FSO.GetFolder(searchPath).Files
' separateNum = InStrRev(objFiles.Path, "\")
' 'セルにパスとファイル名を書き込む
' ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
' ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
' ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
' ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
' ActiveCell.Offset(1, 0).Select
'// 対象ファイルをログに出力
Debug.Print (objFiles.Path)
'// ファイルを変換
Call replaceFromFile(objFiles.Path)
Next
End Sub
'
' 機能: 指定ファイルをPostgreSQLの構文に変換する。
'
' 返り値: なし
'
' 機能説明: 引数に指定したファイルをPostgreSQLの構文に変換する。
'
' 備考: 入力ファイルはOracleのDDLファイルのみ対応
'
Public Function replaceFromFile(FileName As String)
Dim FSO As FileSystemObject 'ファイルシステムオブジェクト
Dim Txt As TextStream 'テキストストリームオブジェクト
Dim buf_strTxt As String '読み込みバッファ
On Error GoTo Func_Err:
'オブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Txt = FSO.OpenTextFile(FileName, ForReading)
'全文読み込み
buf_strTxt = Txt.ReadAll
Txt.Close
'元ファイルをリネームして、テンポラリファイル作成
Name FileName As FileName & "_"
'置換処理
buf_strTxt = Replace(buf_strTxt, "NUMBER", "NUMERIC", , , vbBinaryCompare)
buf_strTxt = Replace(buf_strTxt, "NVARCHAR2", "VARCHAR", , , vbBinaryCompare)
buf_strTxt = Replace(buf_strTxt, "VARCHAR2", "VARCHAR", , , vbBinaryCompare)
buf_strTxt = Replace(buf_strTxt, "CLOB", "TEXT", , , vbBinaryCompare)
buf_strTxt = Replace(buf_strTxt, "exit;", "", , , vbBinaryCompare)
'書込み用テキストファイル作成
Set Txt = FSO.CreateTextFile(FileName, True)
'書込み
Txt.Write buf_strTxt
Txt.Close
'テンポラリファイルを削除
FSO.DeleteFile FileName & "_"
'終了処理
Func_Exit:
Set Txt = Nothing
Set FSO = Nothing
Exit Function
Func_Err:
MsgBox "Error Number : " & Err.Number & vbCrLf & Err.Description
GoTo Func_Exit:
End Function
Function SJIS_to_UTF8(FN As String)
Dim FROM_OBJ As Object
Dim TO_OBJ As Object
Set FROM_OBJ = CreateObject("ADODB.Stream")
With FROM_OBJ
.Type = 2
.Charset = "shift-jis"
.Open
.LoadFromFile FN
.Position = 0
End With
Set TO_OBJ = CreateObject("ADODB.Stream")
With TO_OBJ
.Type = 2
.Charset = "utf-8"
.Open
End With
FROM_OBJ.CopyTo TO_OBJ
TO_OBJ.Position = 0
TO_OBJ.SaveToFile FN & "_utf.txt", 2
End Function