CSVが文字コードUTF-8かどうかの判定

質問

かなりデータ量が多い（10万レコード超）CSVファイルが、100件近くあります。これをエクセルに取り込んで順次同じような作業をしようと思っています。とりあえずCSVを以下のコードで開いています。

Sub CSV入力4() 'クエリーテーブルを使ったCSV読み込みVBAコード
Dim myFile As Variant

myFile = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If myFile = False Then
Exit Sub
End If
ActiveSheet.Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="text;" & myFile, Destination:=Range("A1"))
' .TextFilePlatform = 932 'Shift_Jis
.TextFilePlatform = 65001 'UTF8
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With
MsgBox "読込完了"
End Sub

問題は、CSVに拡張子で区別できないUTF-8のCSVファイルがあることです。事前にわかっていれば
.TextFilePlatform = 932 'Shift_Jis
.TextFilePlatform = 65001 'UTF8
の使い分けで対応できるのですが、開いてみて文字化けがあるかどうか調べないとわかりません。自動的に判定する方法はないでしょうか？

回答No.8

kkkkkm · ベストアンサー

その3
'----UTF8関係
' 関数名 : JudgeUTF8
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : UTF8の文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeUTF8(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As Long
Dim i As Long
Dim lngFit As Long
Dim lngUB As Long

lngUB = JUDGESIZEMAX - 1
If lngUB > UBound(bytCode()) Then
lngUB = UBound(bytCode())
End If
For i = 0 To lngUB
If fixFlag Then
'BOM
If bytCode(i) = &HEF Then
If i <= UBound(bytCode) - 2 Then
If bytCode(i + 1) = &HBB And _
bytCode(i + 2) = &HBF Then
JudgeUTF8 = JUDGEFIX_BOM
Exit Function
End If
End If
End If
End If

'AND FC(1バイト目) + 80-BF(2-6バイト目)
If (bytCode(i) And &HFC) = &HFC Then
If i <= UBound(bytCode) - 5 Then
If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
(bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
(bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) And _
(bytCode(i + 4) >= &H80 And bytCode(i + 4) <= &HBF) And _
(bytCode(i + 5) >= &H80 And bytCode(i + 5) <= &HBF) Then
lngFit = lngFit + (6 * Multi_ByteWeight)
i = i + 5
End If
End If

'AND F8(1バイト目) + 80-BF(2-5バイト目)
ElseIf (bytCode(i) And &HF8) = &HF8 Then
If i <= UBound(bytCode) - 4 Then
If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
(bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
(bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) And _
(bytCode(i + 4) >= &H80 And bytCode(i + 4) <= &HBF) Then
lngFit = lngFit + (5 * Multi_ByteWeight)
i = i + 4
End If
End If

'AND F0(1バイト目) + 80-BF(2-4バイト目)
ElseIf (bytCode(i) And &HF0) = &HF0 Then
If i <= UBound(bytCode) - 3 Then
If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
(bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
(bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) Then
lngFit = lngFit + (4 * Multi_ByteWeight)
i = i + 3
End If
End If

'AND E0(1バイト目) + 80-BF(2-3バイト目)
ElseIf (bytCode(i) And &HE0) = &HE0 Then
If i <= UBound(bytCode) - 2 Then
If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
(bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) Then
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
End If
End If

'AND C0(1バイト目) + 80-BF(2バイト目)
ElseIf (bytCode(i) And &HC0) = &HC0 Then
If i <= UBound(bytCode) - 1 Then
If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) Then
lngFit = lngFit + (2 * Multi_ByteWeight)
i = i + 1
End If
End If

'20-7E(1バイト目)
ElseIf (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
lngFit = lngFit + (1 * SingleByteWeight)

'00-1F, 7F(1バイト目)
ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
bytCode(i) = &H7F Then
lngFit = lngFit + (1 * SingleByteWeight)
End If
Next i
JudgeUTF8 = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function

以上です。

お礼

ゴールデンウィーク中にもかかわらず丁寧なご指導をいただき、たいへんありがとうございます。おかげさまで解決しました！これで安心して休み明けに怖い上司の顔を見られそうです。これからもよろしくお願いいたします。

Powered by GRATICA

回答No.11

SI299792

最初の1000件読んで、文字化けを見つけたら、UTF8とみなすという強引なやり方です。
（全部読むと時間がかかると思うので）
（コメントを見る限り、UTF8とShift Jis 以外ないみたいなので）
その為、UTF16 等、この２つ以外があれば文字化けを起こします。
Option Explicit
'
Sub Macro1()
Dim FileName As String
Dim Platform As Long
'
FileName = Application.GetOpenFilename( _
"CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If FileName = "False" Then
Exit Sub
End If
'
If Garbled(FileName) Then
Platform = 65001
Else
Platform = 932
End If
Cells.Clear
'
With ActiveSheet.QueryTables.Add("text;" & FileName, [A1])
.TextFilePlatform = Platform
.TextFileCommaDelimiter = True
.Refresh
.Delete
End With
MsgBox "読込完了"
End Sub
'
Function Garbled(ByVal File As String) As Boolean
Dim No As Integer
Dim Count As Long
Dim Start As Integer
Dim Str1 As String
'
No = FreeFile
Open File For Input As #No
'
Do Until EOF(No) Or Garbled Or Count > 999
Line Input #No, File
'
For Start = 1 To Len(File)
Str1 = Mid(File, Start, 1)
'
If Asc(Str1) < 32 Then
Garbled = True
End If
Next Start
Count = Count + 1
Loop
Close #No
End Function

お礼

ありがとうございます。

Powered by GRATICA

回答No.10

kkkkkm

回答No.9の補足です。

> 1000バイト以内に比較で差が出る要素が無かったとか・・・

元のコードでは他との比較の一番最初がShift_Jisで最優先になっていました。

差が無い場合に元の優先順位にあわせるのでしたら私のコードの

If lngUTF8 >= lngSJIS Then
JudgeCode = UTF_8
Exit Function
End If

の前に

If lngSJIS >= lngUTF8 Then
JudgeCode = S_JIS
Exit Function
End If

を入れて

以下のようにしてあわせておいた方がいいのかもしれません。

If lngSJIS >= lngUTF8 Then
JudgeCode = S_JIS
Exit Function
End If

If lngUTF8 >= lngSJIS Then
JudgeCode = UTF_8
Exit Function
End If

お礼

ありがとうございます。

Powered by GRATICA

回答No.9

kkkkkm

もしかしての世界なのですが

Private Const JUDGESIZEMAX = 1000 '文字コード判定バイト数

1000バイト以内に比較で差が出る要素が無かったとか・・・
これを大きくしたらどうなるでしょう。

お礼

いえいえ、ちがいました。ありがとうございます。

Powered by GRATICA

回答No.7

kkkkkm

その2

'----SJIS関係
' 関数名 : JudgeSJIS
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : SJISの文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeSJIS(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As Long 'Integer
Dim i As Long
Dim lngFit As Long
Dim lngUB As Long

lngUB = JUDGESIZEMAX - 1
If lngUB > UBound(bytCode()) Then
lngUB = UBound(bytCode())
End If
For i = 0 To lngUB
'81-9F,E0-EF(1バイト目)
If (bytCode(i) >= &H81 And bytCode(i) <= &H9F) Or _
(bytCode(i) >= &HE0 And bytCode(i) <= &HEF) Then
If i <= UBound(bytCode) - 1 Then
'40-7E,80-FC(2バイト目)
If (bytCode(i + 1) >= &H40 And bytCode(i + 1) <= &H7E) Or _
(bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HFC) Then
lngFit = lngFit + (2 * Multi_ByteWeight)
i = i + 1
End If
End If

'A1-DF(1バイト目)
ElseIf (bytCode(i) >= &HA1 And bytCode(i) <= &HDF) Then
lngFit = lngFit + (1 * SingleByteWeight)

'20-7E(1バイト目)
ElseIf (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
lngFit = lngFit + (1 * SingleByteWeight)

'00-1F, 7F(1バイト目)
ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
bytCode(i) = &H7F Then
lngFit = lngFit + (1 * SingleByteWeight)
End If
Next i
JudgeSJIS = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function

お礼

ありがとうございます。

Powered by GRATICA

回答No.6

kkkkkm

> BOM付きの場合はUTF8を判断して正しく表示されました。

以下のコードでtest()を実行したら
正しく判定してくれましたし
testBOM.csv は　BOM付UTF-8
test.csv 　は BOM無しUTF-8
testSjis.csv は　S-JIS

結果
testBOM.csv = 65001
test.csv = 65001
testSjis.csv = 932

添付画像は上がUTF-8下がBOM付UTF-8のバイナリエディタでの表示です。

CSV入力4()でも判定してくれました

それほど大きなファイルではありませんでしたがファイルの大きさが関係しているのでしょうか。

'****************************************************************************
' 機能名 : Module1.bas
' 機能説明 : 文字コード判定
' 備考 :
' 著作権 : Copyright(C) 2008 - 2009 のん All rights reserved
' ---------------------------------------------------------------------------
' 使用条件 : このサイトの内容を使用(流用/改変/転載/等全て)した成果物を不特定
' : 多数に公開/配布する場合は、このサイトを参考にした旨を記述してく
' : ださい。(例)WEBページやReadMeにリンクを貼ってください
' ---------------------------------------------------------------------------
'****************************************************************************
Private Const JUDGEFIX = 9999 '文字コード決定％
Private Const JUDGEFIX_BOM = 999999
Private Const JUDGESIZEMAX = 1000 '文字コード判定バイト数
Private Const SingleByteWeight = 1 '１バイト　文字コードの一致重み
Private Const Multi_ByteWeight = 2 '複数バイト文字コードの一致重み
Private Const S_JIS As Long = 932
Private Const UTF_8 As Long = 65001

Sub test()

Debug.Print "testBOM.csv = "; getCodePage("C:\Ok\test\testBOM.csv")
Debug.Print "test.csv = "; getCodePage("C:\Ok\test\test.csv")
Debug.Print "testSjis.csv = "; getCodePage("C:\Ok\test\testSjis.csv")

End Sub

Sub CSV入力4() 'クエリーテーブルを使ったCSV読み込みVBAコード
Dim myFile As Variant

myFile = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If myFile = False Then
Exit Sub
End If
ActiveSheet.Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="text;" & myFile, Destination:=Range("A1"))
' .TextFilePlatform = 932 'Shift_Jis
' .TextFilePlatform = 65001 'UTF8

.TextFilePlatform = getCodePage(CStr(myFile))

.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With
MsgBox "読込完了"
End Sub

Public Function getCodePage(filePath As String) As Long
Dim obj As Object
Set obj = CreateObject("ADODB.Stream")

'まずは判定のためにバイナリモードで取得する
Dim bytCode() As Byte
With obj
.Open
.Type = 1
.LoadFromFile (filePath)
bytCode = .read
.Close
End With

'取得したバイト配列を使用して文字コードの判定を行う
getCodePage = JudgeCode(bytCode)

End Function
'----文字コード判定
' 関数名 : JudgeCode
' 返り値 : 判定結果文字コード名
' 引き数 : bytCode : 判定文字データ
' 機能説明 : 文字コードを判定する
' 備考 :
Public Function JudgeCode(ByRef bytCode() As Byte) As Long

JudgeCode = S_JIS

Dim lngSJIS As Long
Dim lngUTF8 As Long

lngSJIS = JudgeSJIS(bytCode, True)
If lngSJIS >= JUDGEFIX Then JudgeCode = S_JIS: Exit Function

lngUTF8 = JudgeUTF8(bytCode, True)
If lngUTF8 >= JUDGEFIX Then JudgeCode = UTF_8: Exit Function

If lngUTF8 >= lngSJIS Then
JudgeCode = UTF_8
Exit Function
End If

End Function
続く
コードは別々に回答します。

お礼

大変ありがとうございます。助かりました。

Powered by GRATICA

回答No.5

kkkkkm

emaxemaxさんでしたら分かると思いますけど、はなから分からないかもしれないとかはひどく失礼な感じですね。

それに必要な文字コードの部分だけコピペすればいいだけで全てコピペする必要は無いとも思います。

お礼

ありがとうございます。BOM付きの場合はUTF8を判断して正しく表示されました。

Powered by GRATICA

回答No.4

HohoPapa

先のコメントに登場する
'https://vbaexcel.slavesystems.com/vba/?p=1193
このサイトだけではわからないかもしれないので、
私の使用例を書きます。

まず、このサイトにある６２８行のコードを
適当なモジュール（例えばModule2）に配置し、
質問文にポストしたコードを以下のように直します。

Option Explicit

Sub CSV入力4() 'クエリーテーブルを使ったCSV読み込みVBAコード
Dim myFile As String
Dim Platform As String

myFile = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If myFile = "False" Then
Exit Sub
End If

If GetcharSet(myFile) = "UTF-8" Then
Platform = 65001
ElseIf GetcharSet(myFile) = "Shift_JIS" Then
Platform = 932
Else
MsgBox "対応できる文字コードではない"
End If

ActiveSheet.Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="text;" & myFile, Destination:=Range("A1"))
' .TextFilePlatform = 932 'Shift_Jis
' .TextFilePlatform = 65001 'UTF8

.TextFilePlatform = Platform

.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With
MsgBox "読込完了"
End Sub

'//---------------------------------------------------------
'//文字コードを取得する関数
'//---------------------------------------------------------
Public Function GetcharSet(filePath As String) As String

Dim obj As Object
Set obj = CreateObject("ADODB.Stream")

'まずは判定のためにバイナリモードで取得する
Dim bytCode() As Byte
With obj
.Open
.Type = 1
.LoadFromFile (filePath)
bytCode = .Read
.Close
End With

'取得したバイト配列を使用して文字コードの判定を行う
GetcharSet = JudgeCode(bytCode)

End Function

お礼

ご丁寧にありがとうございます。BOM付きの場合はUTF8を判断して正しく表示されました。

Powered by GRATICA

回答No.3

kkkkkm

回答No.2の補足です。

UTF-8がBOMありでしたらCSVをExcelブックとして開けば文字化けなしでいけますから、開いたら文字化けということですのでBOMありではなさそうですね。

お礼

何度もありがとうございます。たしかにエクセルでダブルクリックで開けばBOM付きであればUTF8でも文字化けせず開けます。しかし質問にあげたVBAで開いた場合はBOMの有無にかかわらずUTF8の日本語は文字化けしてしまうのです。

Powered by GRATICA

回答No.2

kkkkkm

回答No.1の追加です。

UTF-8がBOMありでしたら以下のサイトのコードで判別できます。

Excel：VBAで､テキストファイルの文字コードを自動判定　
http://3335.blog106.fc2.com/blog-entry-141.html

C:\Users\ユーザー名\AppData\Local\Temp\ファイル名
で一時的にファイルが作成されます。

お礼

ありがとうございました。これもBOM付きであればUTF8かどうかの判定ができました。

Powered by GRATICA

回答No.1

kkkkkm

こちらを参考にして必要な部分を取り込んでみてはいかがでしょう。

【VBA】文字コードを判定してファイルを読み込む
https://vbaexcel.slavesystems.com/vba/?p=1193

お礼

ありがとうございました。BOM付きであればUTF8かどうかの判定ができました。しかしBOM付きでなければShift_JISと判定されるようです。

Powered by GRATICA