макрос для преобразования shift-JIS в кодировку UTF-8 - PullRequest
0 голосов
/ 18 октября 2019

У меня есть 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...