VBAでファイルの文字コード判定を行う

VBAで文字コードの判定を行います。

何故かVBAに無い「文字コード判定」

Microsoft Excel では、［データ］→［テキスト ファイル］と選んでいって、ファイルを選択すると文字コードの判定を自動でしてくれます。

この判定がVBAから利用できれば便利なのに、VBAにはその命令がありません。

関数を追加する

そこで、文字コード（文字エンコード）を判定する関数を作成してみました。

VBAのエディタを開いたら、プロジェクト エクスプローラーで右クリック→［挿入］→［標準モジュール］として、以下を貼り付けてください。

Option Explicit

'fncGetCharset Ver1.6 @popozure
Function fncGetCharset(FileName As String) As String
    Dim i                   As Long     '汎用指数
      
    Dim lngFileLen          As Long     'ファイルサイズ
    Dim bytFile()           As Byte     'ファイル内容
    Dim b1                  As Byte     '1バイト目
    Dim b2                  As Byte     '2バイト目
    Dim b3                  As Byte     '3バイト目
    Dim b4                  As Byte     '4バイト目
      
    Dim lngSJIS             As Long     'Shift_JISの可能性
    Dim lngUTF8             As Long     'UTF-8もの可能性
    Dim lngEUC              As Long     'EUC-JPの可能性
    
    'ADODB定数
    Const adModeUnknown = 0
    Const adModeRead = 1
    Const adModeWrite = 2
    Const adModeReadWrite = 3
    Const adModeShareDenyRead = 4
    Const adModeShareDenyWrite = 8
    Const adModeShareExclusive = 12
    Const adModeShareDenyNone = 16
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adReadAll = -1
    Const adReadLine = -2
    
    'ファイル読み込み（バイナリー）
    On Error Resume Next
    With CreateObject("ADODB.Stream")
        .Mode = adModeUnknown
        .Open
        .Type = adTypeBinary
        .LoadFromFile FileName
        lngFileLen = .Size
        bytFile = .Read(adReadAll)
        .Close
    End With
    If (Err.Number <> 0) Then
        fncGetCharset = "OPEN FAILED"
        Exit Function
    End If
    On Error GoTo 0
    
    'BOMによる判断
    If (bytFile(0) = &HEF And bytFile(1) = &HBB And bytFile(2) = &HBF) Then
        fncGetCharset = "UTF-8 BOM"
        Exit Function
    ElseIf (bytFile(0) = &HFF And bytFile(1) = &HFE) Then
        fncGetCharset = "UTF-16 LE BOM"
        Exit Function
    ElseIf (bytFile(0) = &HFE And bytFile(1) = &HFF) Then
        fncGetCharset = "UTF-16 BE BOM"
        Exit Function
    End If
      
    'BINARY
    For i = 0 To lngFileLen - 1
        b1 = bytFile(i)
        If ((b1 >= &H0 And b1 <= &H1F) And b1 <> &H9 And b1 <> &HA And b1 <> &HD And b1 <> &H1B) Or (b1 = &H7F) Then
            fncGetCharset = "BINARY"
            Exit Function
        End If
    Next i
             
    'SJIS
    For i = 0 To lngFileLen - 1
        b1 = bytFile(i)
        If (b1 = &H9) Or (b1 = &HA) Or (b1 = &HD) Or (b1 >= &H20 And b1 <= &H7E) Or (b1 >= &HB0 And b1 <= &HDF) Then
            lngSJIS = lngSJIS + 1
        Else
            If (i < lngFileLen - 2) Then
                b2 = bytFile(i + 1)
                If ((b1 >= &H81 And b1 <= &H9F) Or (b1 >= &HE0 And b1 <= &HFC)) And _
                   ((b2 >= &H40 And b2 <= &H7E) Or (b2 >= &H80 And b2 <= &HFC)) Then
                   lngSJIS = lngSJIS + 2
                   i = i + 1
                End If
            End If
        End If
    Next i
             
    'UTF-8
    For i = 0 To lngFileLen - 1
        b1 = bytFile(i)
        If (b1 = &H9) Or (b1 = &HA) Or (b1 = &HD) Or (b1 >= &H20 And b1 <= &H7E) Then
            lngUTF8 = lngUTF8 + 1
        Else
            If (i < lngFileLen - 2) Then
                b2 = bytFile(i + 1)
                If (b1 >= &HC2 And b1 <= &HDF) And (b2 >= &H80 And b2 <= &HBF) Then
                   lngUTF8 = lngUTF8 + 2
                   i = i + 1
                Else
                    If (i < lngFileLen - 3) Then
                        b3 = bytFile(i + 2)
                        If (b1 >= &HE0 And b1 <= &HEF) And (b2 >= &H80 And b2 <= &HBF) And (b3 >= &H80 And b3 <= &HBF) Then
                            lngUTF8 = lngUTF8 + 3
                            i = i + 2
                        Else
                            If (i < lngFileLen - 4) Then
                                b4 = bytFile(i + 3)
                                If (b1 >= &HF0 And b1 <= &HF7) And (b2 >= &H80 And b2 <= &HBF) And (b3 >= &H80 And b3 <= &HBF) And (b4 >= &H80 And b4 <= &HBF) Then
                                    lngUTF8 = lngUTF8 + 4
                                    i = i + 3
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next i
  
    'EUC-JP
    For i = 0 To lngFileLen - 1
        b1 = bytFile(i)
        If (b1 = &H9) Or (b1 = &HA) Or (b1 = &HD) Or (b1 >= &H20 And b1 <= &H7E) Then
            lngEUC = lngEUC + 1
        Else
            If (i < lngFileLen - 2) Then
                b2 = bytFile(i + 1)
                If ((b1 >= &HA1 And b1 <= &HFE) And _
                   (b2 >= &HA1 And b2 <= &HFE)) Or _
                   ((b1 = &H8E) And (b2 >= &HA1 And b2 <= &HDF)) Then
                   lngEUC = lngEUC + 2
                   i = i + 1
                End If
            End If
        End If
    Next i
             
    '文字コード出現順位による判断
    If (lngSJIS <= lngUTF8) And (lngEUC <= lngUTF8) Then
        fncGetCharset = "UTF-8"
        Exit Function
    End If
    If (lngUTF8 <= lngSJIS) And (lngEUC <= lngSJIS) Then
        fncGetCharset = "Shift_JIS"
        Exit Function
    End If
    If (lngUTF8 <= lngEUC) And (lngSJIS <= lngEUC) Then
        fncGetCharset = "EUC-JP"
        Exit Function
    End If
    
    '判定不能
    fncGetCharset = "UNKNOWN"
End Function

判定方法については以下のサイトを参考にさせていただきました。

dobon.net

 

51 Users

17 Pockets

文字コードを判別する

https://dobon.net/vb/dotnet/string/detectcode.html

文字コードを判別する BOMで判断する方法 Jcode.pmを参考にした方法 第三者の作成したクラス、コードを使う方法 mlang.dllのIMultiLanguage2::DetectInputCodepageを使う方法 COMを登録して、参照設定に追加する DetectInputCodepageメソッドを使用する サンプル この記事への評価、コメント

使い方

VBAの中から関数として呼び出します。

ファイル名のダイアログが表示されるので検査したいファイル名を指定すると可能性の高い文字コードが表示されます。

'関数のテスト処理
Sub Main()
    Application.FileDialog(msoFileDialogFilePicker).Show
    MsgBox "ファイル名: " & Dir(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)) & vbCrLf & "判定結果: " & fncGetCharset(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)), vbInformation
End Sub

結果としては、以下の文字列が返ってきます。

手元にあるファイルで試したところ十分に判定してくれています。

Unicodeの基本コード（エンコーディング・符号化）であるUTF-8は互換性のために、英数字（ASCII文字）だけを使用したテキストファイルはANSIと全く同じファイルになります。

もうちょっと簡単に言うと半角英数字だけを使った場合、「UTF-8」でもあり、「Shift_JIS」でもある状態になります。この関数では「UTF-8」を返すようになっています。（多くのテキストエディタではShift_JISと判定していると思います）

では、この辺で。(^-^)o