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

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

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

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

関数を追加する

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

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

[vb title=”fncGetCharset.bas”]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[/vb]

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

[link url=”https://dobon.net/vb/dotnet/string/detectcode.html”]

使い方

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

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

[vb title=”test.bas”]’関数のテスト処理
Sub Main()
Application.FileDialog(msoFileDialogFilePicker).Show
MsgBox "ファイル名: " & Dir(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)) & vbCrLf & "判定結果: " & fncGetCharset(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)), vbInformation
End Sub[/vb]

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

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

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

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

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