VBA JISファイルを S-JISファイルへ変換するモジュール

VBA モジュール

VBA JISファイルを S-JISファイルへ変換するモジュールファイルのキャラクターセットの変換方法にはいくつかありますが、JIS , UTF8 , Shift-Jis変化には、ADODB.Streamを使うのが一般的と個人的には思います。

VBA JISファイルを S-JISファイルへ変換するモジュール

モジュールのソースは以下になります。

Function WriteTextFile(ByVal frFilePath As String, ByVal frFileCharSet As String, ByVal toFilePath As String, ByVal toFileCharSet As String)
    '
    'ツール -> 参照設定 -> Microsoft ActiveX Data Objects 6.1 Library
    '
    'stat= jis2022.WriteTextFile(frFilePath, "ISO-2022-JP",toFilePath, "Shift-JIS")
    'If stat <> "" Then
    '    MsgBox (stat)
    'End If
    '
    '-----
    '.Charset "UTF-8"、"EUC-JP"、"Shift-JIS"、"ISO-2022-JP"（JIS）
    '-----
    '
    '
    WriteTextFile = ""
    
    Dim streamRead  As New ADODB.Stream '// 読み込みデータ
    Dim streamWrite As New ADODB.Stream '// 書き込みデータ
    Dim sText                           '// ファイルデータ
    
    '// ファイル読み込み
    streamRead.Type = adTypeText
    streamRead.Charset = frFileCharSet
    streamRead.Open
    erms = ""
    On Error GoTo rsm
    Call streamRead.LoadFromFile(frFilePath)
    On Error GoTo 0
    If erms <> "" Then
        WriteTextFile = "READ:" + erms
        Exit Function
    End If
    '// 改行コードLFをCRLFに変換
    sText = streamRead.ReadText
    sText = Replace(sText, vbLf, vbCrLf)
    sText = Replace(sText, vbCr & vbCr, vbCr)
    
    '// ファイル書き込み
    streamWrite.Type = adTypeText
    streamWrite.Charset = toFileCharSet
    streamWrite.Open
    
    '// データ書き込み
    On Error GoTo rsm
    Call streamWrite.WriteText(sText)
    On Error GoTo 0
    If erms <> "" Then
        WriteTextFile = "WRITE:" + erms
        Exit Function
    End If
    
    '// 保存
    Call streamWrite.SaveToFile(toFilePath, adSaveCreateOverWrite)
    
    '// クローズ
    streamRead.Close
    streamWrite.Close
    
    
    Exit Function
rsm:
    erms = Err.Description
    Resume Next
End Function

0001 Function WriteTextFile(ByVal frFilePath As String, ByVal frFileCharSet As String, ByVal toFilePath As String, ByVal toFileCharSet As String)
0002 '
0003 'ツール -> 参照設定 -> Microsoft ActiveX Data Objects 6.1 Library
0004 '
0005 'stat= jis2022.WriteTextFile(frFilePath, "ISO-2022-JP",toFilePath, "Shift-JIS")
0006 'If stat <> "" Then
0007 '    MsgBox (stat)
0008 'End If
0009 '
0010 '-----
0011 '.Charset "UTF-8"、"EUC-JP"、"Shift-JIS"、"ISO-2022-JP"（JIS）
0012 '-----
0013 '
0014 '
0015 WriteTextFile = ""
0016 
0017 Dim streamRead  As New ADODB.Stream '// 読み込みデータ
0018 Dim streamWrite As New ADODB.Stream '// 書き込みデータ
0019 Dim sText                           '// ファイルデータ
0020 
0021 '// ファイル読み込み
0022 streamRead.Type = adTypeText
0023 streamRead.Charset = frFileCharSet
0024 streamRead.Open
0025 erms = ""
0026 On Error GoTo rsm
0027 Call streamRead.LoadFromFile(frFilePath)
0028 On Error GoTo 0
0029 If erms <> "" Then
0030 WriteTextFile = "READ:" + erms
0031 Exit Function
0032 End If
0033 '// 改行コードLFをCRLFに変換
0034 sText = streamRead.ReadText
0035 sText = Replace(sText, vbLf, vbCrLf)
0036 sText = Replace(sText, vbCr & vbCr, vbCr)
0037 
0038 '// ファイル書き込み
0039 streamWrite.Type = adTypeText
0040 streamWrite.Charset = toFileCharSet
0041 streamWrite.Open
0042 
0043 '// データ書き込み
0044 On Error GoTo rsm
0045 Call streamWrite.WriteText(sText)
0046 On Error GoTo 0
0047 If erms <> "" Then
0048 WriteTextFile = "WRITE:" + erms
0049 Exit Function
0050 End If
0051 
0052 '// 保存
0053 Call streamWrite.SaveToFile(toFilePath, adSaveCreateOverWrite)
0054 
0055 '// クローズ
0056 streamRead.Close
0057 streamWrite.Close
0058 
0059 
0060 Exit Function
0061 rsm:
0062 erms = Err.Description
0063 Resume Next
0064 End Function

VBA JISファイルを S-JISファイルへ変換するモジュールの使い方参照設定

VBA メニューからツール -> 参照設定 -> Microsoft ActiveX Data Objects 6.1 Library を追加します。

VBA JISファイルを S-JISファイルへ変換するモジュールの使い方

前述モジュールは JISファイルを S-JISファイルへ変換するだけではなく次の文字セットの相互変換ができます。 “UTF-8″、”EUC-JP”、”Shift-JIS”、”ISO-2022-JP” 実際の使い方は、ソースに書き込んであるように次の方法で可能です。書式 stat = jis2022.WriteTextFile(frFilePath, frFileCharset,toFilePath, toFileCharset) stat：戻りステータス成功＝’’、失敗時には’’失敗原因がも入ってきます。 frFilePath：変換元ファイルパス frFileCharset：変換元ファイル文字セット toFilePath：変換先ファイルパス toFileCharset：変換先ファイル文字セット例、

    stat= jis2022.WriteTextFile(frFilePath, "ISO-2022-JP",toFilePath, "Shift-JIS")
    If stat <> "" Then
        '失敗
        MsgBox (stat)
    End If

0001 stat= jis2022.WriteTextFile(frFilePath, "ISO-2022-JP",toFilePath, "Shift-JIS")
0002 If stat <> "" Then
0003 '失敗
0004 MsgBox (stat)
0005 End If

VBA JISファイルを S-JISファイルへ変換するモジュールの注意点

改行を強制的に LFをCRLFに　していますが、多くの場面では問題ないと思いますが、場面によっては統合が悪いことも考えられますのでその場合には以下の部分をsy風制して使用してください。

    End If
    '// 改行コードLFをCRLFに変換
    sText = streamRead.ReadText
    sText = Replace(sText, vbLf, vbCrLf)
    sText = Replace(sText, vbCr & vbCr, vbCr)

0001 End If
0002 '// 改行コードLFをCRLFに変換
0003 sText = streamRead.ReadText
0004 sText = Replace(sText, vbLf, vbCrLf)
0005 sText = Replace(sText, vbCr & vbCr, vbCr)

この記事が、あなたの一助になれば幸いです。