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

VBA
この記事は約13分で読めます。

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

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

使い方

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

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

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

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

返り値 文字コード
UTF-16 LE BOM Unicode (UTF-16 LE)(BOM付き)
UTF-16 BE BOM Unicode (UTF-16 BE)(BOM付き)
UTF-8 BOM UTF-8(BOM付き)
UTF-8 UTF-8(BOM無し)
Shift_JIS シフトJIS
BINARY テキストでは無いファイル
OPEN FAILED アクセス失敗もしくは0バイト
UNKNOWN 判定不能

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

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

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

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

コメント

  1. プログラミング初心者です。とても参考になる記事で助かります。
    一つ質問なのですが、 ‘BINARY の行から数えて4行目の

    b1 >= &HA And b1 <=&H9

    は不等号の表記間違いでいいんでしょうか?
    大小関係が逆に見えます

    • ddさん、コメントありがとうございます。

      参考になったようで良かったです。

      ソースを表示するプラグインが無効となっていたため見づらくて申し訳ありませんでした。

      さて、ご指摘の行ですが「そもそもその行は削除する」のが正しかったのですが削除をし忘れていました。

      可読性が上がるか分かりませんが表記を変更しました。

      ちなみにここのIf文は、テキストに存在しないコードがあった場合はバイナリーと判断する部分です。

      具体的には制御コードの内、&H09 TAB、&H0A LF、&H0D CR、&H1B ESC はテキストに存在しうるという判定です。&H7FはDELでテキストには含まれません。

      【修正前】

      If (b1 >= &H00 And b1 <= &H08) Or _  '&H00 - &H08
         (b1 >= &H0A And b1 <= &H09) Or _  'この条件は不要だった
         (b1 >= &H0B And b1 <= &H0C) Or _  '&H0B - &H0C
         (b1 >= &H0E And b1 <= &H19) Or _  '&H0E - &H19
         (b1 >= &H1C And b1 <= &H1F) Or _  '&H1C - &H1F
         (b1  = &H7F) Then                 '&H7F

      【修正後】

      If ((b1 >= &H0 And b1 <= &H1F) And _  '&H00-&H1Fは制御コード
           b1 <> &H9 And _                  '&H09 TAB
           b1 <> &HA And _                  '&H0A 改行
           b1 <> &HD And _                  '&H0D 改行
           b1 <> &H1B) Or _                 '&H1B ESC
         (b1 = &H7F) Then                   '&H7Fは制御コード
  2. すみません教えてください。

    UTF8 の下記判定について。

    b4 >= &H80 And b3 <= &HBF

    となっていますが、2番目はb4だったりするでしょうか?

    • 松の間さん、コメントありがとうございます。

      ご指摘の箇所ですが、

      And (b3 >= &H80 And b3 <= &HBF) And (b4 >= &H80 And b3 <= &HBF) Then

      という表記でしたが、最後の「b3」は「b4」が正しいです。

      And (b3 >= &H80 And b3 <= &HBF) And (b4 >= &H80 And b4 <= &HBF) Then

      記事を修正しました。

  3. 有意義な記事で助かります。
    掲載コードの52~63行目にかけて適切な改行がなされていないようです。
    単なるコピペでは動きませんです。

    • おぼれさん、コメント&ご指摘ありがとうございます。

      なかなかこの手の話題が見つからなくて、自分で記事にしたものなので活用していただけるとありがたいです。

      記事内のプログラムを修正しました。

タイトルとURLをコピーしました