VBAを使用したCSVデータの一括読み込み方法について備忘録的に紹介していきたいと思います。
今回紹介する内容は以下の２つです。
- 文字コードを指定してCSVデータを読み込む方法
- 文字コードを自動判定して読み込む方法
前回までの記事について
①のCSV読込のためのOpenステートメント、Line Input #ステートメントを使ったコードを紹介した記事はこちら。
ExcelVBAを使ったCSVデータの読み込み まとめ①
VBAを使用したCSVデータの一括読み込み方法について紹介しています。
ym-pc.com
2022.03.25
②のファイルシステムオブジェクトのText Streamオブジェクトを使った方法を紹介した記事はこちら。
ExcelVBAを使ったCSVデータの読み込み まとめ②
ファイルシステムオブジェクトのText Streamオブジェクトを使った方法を紹介します。
ym-pc.com
2022.03.28
VBAを使ったCSVデータの読み込み（データ要素内の「,」「”」処理）はこちら↓↓
VBAを使ったCSVデータの読み込み「,」「”」処理
VBAでCSVデータを読み込みたい場合に、データ要素内に「,（カンマ）」や「”（）ダブルクォート」が存在している場合の対処方法について解説しています。
ym-pc.com
2024.01.02
文字コードとは
文字に割り振られた番号の事で、ASCIIコード、JISコード、Shift-JIS、UTF-8などがあります。詳しい記事を見つけたのでそちらを参考にしてください。
unicodeとは？文字コードとは？UTF-8とは？ - Qiita
# はじめにタイトルにある通り、文字コードについて学習したことを記載していきたいと思います。# 文字コードとは数字しか認識できないコンピュータが文字を扱うために、人間の文字に対応してそれぞれ割…
qiita.com
文字コードを指定して読み込む
これまで紹介したテキストファイル形式のCSVデータ（テキストファイル形式のカンマ区切りデータ）の読み込みは、すべて文字コードはShift-JISでした。
Shift-JISの場合は基本的には文字化けしないので、特に文字コードを指定する必要はありませんでした。
しかし、例えばWindowsのメモ帳に直接文字を入力すると、文字コードはデフォルトでUTF-8（BOMなし）になっていると思います。
これをそのままマクロでエクセルに読み込むと文字化けが発生してしまいます。
文字コードを指定してテキストファイル３つを一括してエクセルに読み込む
それでは、VBAを使って文字化けすることなく、UTF-8のカンマ区切りテキストファイルの３ファイルを一括してエクセルに読み込んでみたいと思います。（インプット先のエクセル（CSV連結マクロ.xlsm）と同一フォルダ内の「うまい棒一覧データ」（_10日まで、_20日まで、_30日までの３ファイル)を連続して読み込みます。
UTF-8のカンマ区切りテキストファイルは、下のような内容でそれぞれ10日まで、20日まで、30日までのデータが入っています。
エクセルへの読込
大まかなコードの流れ（方法）
- ADODB.Streamオブジェクト（ActiveX Data Object）の生成
- Dir関数を使って、同一フォルダ内のテキストファイルを順番に取得
- ADODB.Streamオブジェクトで文字コードを指定したうえでファイルを読み込む
- ファイルの中身を一行ずつ読み込んだものを変数に格納
- 格納したデータをカンマごとに配列変数に格納
- エクセルシートにエクスポート
1 Sub CSV読み込み_3()
2 Dim file As String
3 Dim ADOst As New ADODB.Stream 'ADODB.Streamオブジェクト（ActiveX Data Object）を生成
4 Dim path As String
5 Dim r As Long
6 Dim buf, tmp As Variant
7 Dim flag As Boolean
8 path = ThisWorkbook.path & "\"
9 file = Dir(ThisWorkbook.path & "\*.txt", vbNormal) '同一フォルダ内のテキストファイルを取得
10 r = 2 '読込先エクセルの行番号
11 Do Until file = "" 'フォルダ内のファイルが空になるまで
12 flag = False
13 ADOst.charSet = "UTF-8" '文字コードを指定
14 ADOst.Open 'STREAMオブジェクトを開きます。
15 ADOst.LoadFromFile path & file 'ファイルのデータをSTREAMに読み込む
16 Do Until ADOst.EOS
17 buf = ADOst.ReadText(-2) '一行づつ変数に格納（STREAMからデータを読み込む）-2はadreadlineでも可
18 If flag = False Then '一行目（タイトル行）をスキップするためのフラッグ
19 flag = True
20 Else
21 tmp = Split(buf, ",") 'buf変数をカンマごとにtmp変数の配列に代入
22 Sheet1.Cells(r, 1).Resize(, UBound(tmp) + 1).Value = tmp 'エクセルに配列データを挿入
23 r = r + 1
24 End If
25 Loop
26 ADOst.Close
27 file = Dir() 'フォルダ内の別ファイルに移行
28 Loop
29 End Sub
ADODB.Streamオブジェクトの生成
ADODB.Streamオブジェクトは、様々な種類のデータへアクセスするために利用できます。CSVファイルの読み込みやAccessデータベースへの接続を行うことができます。
ADODBを利用するための事前準備
VBEにて「ツール」→「参照設定」をチェック
「Microsoft ActiveX Data Object x.x Library」にチェックを入れて「OK」をクリック
ADODBの参照設定を行わない場合
事前に参照設定を行わない場合は、CreateObject関数を使います。その場合
Dim ADOst as Object
Set ADOst = CreateObject(“ADODB.Stream”)
となります。遅延バインディング（実行時バインディング）と言います。
一方の「参照設定」は事前バインディングを言います。
Ｄir関数
ファイルが存在するかどうかを判定する関数でファイル名を返します。
file = Dir(ThisWorkbook.path & "\*.txt", vbNormal) '同一フォルダ内のテキストファイルを取得
引数に＊.txt（ワイルドカード）と入力することで、フォルダ内の全てのテキストファイルを返してくれます。（引数にはフルパスを入力しますが、返り値はフルパスではなく、あくまでファイル名のみです。）
詳細はこちらの過去記事にあります。
ExcelVBAを使ったCSVデータの読み込み まとめ①
VBAを使用したCSVデータの一括読み込み方法について紹介しています。
ym-pc.com
2022.03.25
ADODBオブジェクトのプロパティやメソッド～その１～
ADOst.charSet = "UTF-8" '文字コードを指定
ADOst.Open 'STREAMオブジェクトを開きます。
ADOst.LoadFromFile path & file 'ファイルのデータをSTREAMに読み込む
| プロパティやメソッド | 説明 |
| Charsetプロパティ | テキストファイルの文字コードを指定します。”UTF-8”、”Shift-JIS”、”Unicoad”など |
| Openメソッド | Streamオブジェクトを開きます。「開く」とはデータを操作する状態を開始するようなイメージ |
| LoadFromFileメソッド | 引数で指定したパスのファイルをStreamに読み込む |
| Closeメソッド | Streamオブジェクトを閉じます。 |
つまり、Charsetプロパティで”UTF-8″を指定することで、文字コード：UTF-8のファイルを文字化けすることなく読み込むことが出来ます。
ADODBオブジェクトのプロパティやメソッド～その２～
Do Until ADOst.EOS
buf = ADOst.ReadText(-2) '一行づつ変数に格納（STREAMからデータを読み込む）-2はadreadlineでも可
EOSはテキストファイルの終端という意味なので、「テキストファイルの終端までループ」という意味になります。
ReadTextメソッド
Streamオブジェクトから１行または全文を返します。
Readtext(-1)・・Streamから全文を返します。引数を省略した場合、こちらが規定になります。
Readtext(-2)・・Streamから１行を返します。
その他コード
以降のコードについては、ExcelVBAを使ったCSVデータの読み込み まとめ①に記載したコードの流れと一緒なので割愛します。
注意としては、ADODB.Streamオブジェクトは、Dir関数で次のファイルに移行する前にCloseさせておく必要があります。１ファイルずつ閉じてから次に行くというイメージです。
文字コードを自動判定して読み込む方法
続いては同じフォルダ内にそれぞれ違う文字コードのファイルが存在する場合、それらを一括して読み込む方法をご紹介します。
上のように、フォルダの中のファイルの文字コードがUTF-8だったり、Shift-JISだったりしています。（わかりやすいようにUTF-8の文字コードのファイルはファイル名にUTF-8と記しました。「うまい棒一覧_30日まで」のテキストファイルはShift-JISです。）
文字判定コード（参考サイト）
文字コードを判定するコードについては以下のサイトを参考しました。
私では到底無理ですので活用しました・・・。素晴らしい方がおられます。
NonSoft - 文字コード判定のサンプル(VB6)
SJIS、JIS、EUC、UNICODE(UTF-16)、UTF-7、UTF-8の文字コード判定サンプルソース(VB6)。以下の流れで文字コード判定をしています。100%完璧な文字コード判定は難しいですが出来るだけ精度の高い判定を目指しています。
nonsoft.la.coocan.jp
【VBA】文字コードを判定してファイルを読み込む
VBAでCSVファイルなどのファイル読み込みをする際に、そのファイルの文字コードが不明な場合でも、文字コード判別して読み込めるようにしたいと思いました。外部システムから連携されてくるデータなどは文字コードが決まっているので問題ないケースが多いですが、ユーザが作ったファイルはどの文字コードで登録されているかわからないため...
vbaexcel.slavesystems.com
文字コードを自動判定してフォルダ内テキストファイル一括読み込み
Sub 文字コード判定読込()
Dim s() As String
Dim tmp As Variant
Dim path As String
Dim file As String
Dim r As Long
path = ThisWorkbook.path & "\"
file = Dir(path & "*.txt", vbNormal) 'Dir関数でフォルダ内のファイルを取得
r = 2
Do Until file = "" 'フォルダ内のファイルが空になるまでループ
s = getLines(path & file) 'getLinesファンクションプロシージャ（引数：ファイルのフルパス）へ
Dim i As Long
For i = 1 To UBound(s) - 1'ファイル内の行数分のループをまわす。空行が入るので-1とする。
tmp = Split(s(i), ",") '改行区切の配列（1行分）をカンマ区切で配列変数に代入
Sheet1.Cells(r, 1).Resize(, UBound(tmp) + 1).Value = tmp 'エクセルシートへ読込
r = r + 1
Next i
file = Dir() '次のファイルへ移行
Loop
End Sub
Public Function getLines(filePath As String) As String()
Dim obj As Object
Set obj = CreateObject("ADODB.Stream") 'ADODBオブジェクト生成
'まずは判定のためにバイナリモードで取得する
Dim bytCode() As Byte
With obj
.Open
.Type = 1 'バイナリデータで読込
.LoadFromFile (filePath) '引数のファイルフルパスを読込
bytCode = .Read 'ファイル内の全バイナリデータを変数へ
.Close 'ADODBオブジェクトをクローズ
End With
'取得したバイト配列を使用して文字コードの判定を行う
Dim charSet As String
charSet = JudgeCode(bytCode)'ＪudgeＣodeプロシージャへ（引数：ファイルのバイナリデータ）文字コードを判定。
'返り値:判定された文字コード
Set obj = CreateObject("ADODB.Stream")'ADODBオブジェクト生成
obj.charSet = charSet'判定された文字コードをcharsetプロパティへ
Dim buf As String
With obj
.Open
.LoadFromFile (filePath)
buf = .ReadText'ファイル内全データを変数へ代入
.Close
End With
'改行コードごとに配列変数にする。getLinesファンクションプロシージャへ返す
If InStr(buf, vbCrLf) > 0 Then
getLines = Split(buf, vbCrLf)
ElseIf InStr(buf, vbLf) > 0 Then
getLines = Split(buf, vbLf)
Else
getLines = Split(buf, "")
End If
End Function
'----文字コード判定
' 関数名 : JudgeCode
' 返り値 : 判定結果文字コード名
' 引き数 : bytCode : 判定文字データ
' 機能説明 : 文字コードを判定する
' 備考 :
Public Function JudgeCode(ByRef bytCode() As Byte) As String
JudgeCode = "Shift_JIS"
Dim lngSJIS As Long
Dim lngJIS As Long
Dim lngEUC As Long
Dim lngUNI As Long
Dim lngUTF7 As Long
Dim lngUTF8 As Long
lngJIS = JudgeJIS(bytCode, True)
If lngJIS >= JUDGEFIX Then JudgeCode = "JIS": Exit Function
lngUNI = JudgeUNI(bytCode, True)
If lngUNI >= JUDGEFIX Then JudgeCode = "Unicode": Exit Function
lngUTF8 = JudgeUTF8(bytCode, True)
If lngUTF8 >= JUDGEFIX Then JudgeCode = "UTF-8": Exit Function
lngUTF7 = JudgeUTF7(bytCode, True)
If lngUTF7 >= JUDGEFIX Then JudgeCode = "UTF-7": Exit Function
lngSJIS = JudgeSJIS(bytCode, True)
If lngSJIS >= JUDGEFIX Then JudgeCode = "Shift_JIS: Exit Function"
lngEUC = JudgeEUC(bytCode, True)
If lngEUC >= JUDGEFIX Then JudgeCode = "euc-jp": Exit Function
If lngSJIS >= lngSJIS And lngSJIS >= lngUNI And lngSJIS >= lngJIS And _
lngSJIS >= lngUTF7 And lngSJIS >= lngUTF8 And lngSJIS >= lngEUC Then
JudgeCode = "Shift_JIS"
Exit Function
End If
If lngUNI >= lngSJIS And lngUNI >= lngUNI And lngUNI >= lngJIS And _
lngUNI >= lngUTF7 And lngUNI >= lngUTF8 And lngUNI >= lngEUC Then
JudgeCode = "Unicode"
Exit Function
End If
If lngJIS >= lngSJIS And lngJIS >= lngUNI And lngJIS >= lngJIS And _
lngJIS >= lngUTF7 And lngJIS >= lngUTF8 And lngJIS >= lngEUC Then
JudgeCode = "JIS"
Exit Function
End If
If lngUTF7 >= lngSJIS And lngUTF7 >= lngUNI And lngUTF7 >= lngJIS And _
lngUTF7 >= lngUTF7 And lngUTF7 >= lngUTF8 And lngUTF7 >= lngEUC Then
JudgeCode = "UTF-7"
Exit Function
End If
If lngUTF8 >= lngSJIS And lngUTF8 >= lngUNI And lngUTF8 >= lngJIS And _
lngUTF8 >= lngUTF7 And lngUTF8 >= lngUTF8 And lngUTF8 >= lngEUC Then
JudgeCode = "UTF-8"
Exit Function
End If
If lngEUC >= lngSJIS And lngEUC >= lngUNI And lngEUC >= lngJIS And _
lngEUC >= lngUTF7 And lngEUC >= lngUTF8 And lngEUC >= lngEUC Then
JudgeCode = "euc-jp"
Exit Function
End If
End Function
'----SJIS関係
' 関数名 : JudgeSJIS
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : SJISの文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeSJIS(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As 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
'----JIS関係
' 関数名 : JudgeJIS
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : JISの文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeJIS(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As Integer
Dim i As Long
Dim lngFit As Long
Dim lngMode As JISMODE
Dim lngUB As Long
lngUB = JUDGESIZEMAX - 1
If lngUB > UBound(bytCode()) Then
lngUB = UBound(bytCode())
End If
For i = 0 To lngUB
'1B(1バイト目)
If bytCode(i) = &H1B Then
If i <= UBound(bytCode) - 2 Then
'28 42(2・3バイト目)
If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H42 Then
lngMode = asci
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
'28 4A(2・3バイト目)
If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H4A Then
lngMode = roma
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
'28 49(2・3バイト目)
If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H49 Then
lngMode = kana
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
'24 40(2・3バイト目)
If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H40 Then
lngMode = kanO
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
'24 42(2・3バイト目)
If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H42 Then
lngMode = kanN
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
'24 44(2・3バイト目)
If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H44 Then
lngMode = kanH
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
If fixFlag Then
JudgeJIS = JUDGEFIX
Exit Function
End If
End If
End If
Else
Select Case lngMode
Case ctrl, asci, roma
'00-1F,7F
If (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
bytCode(i) = &H7F Then
lngFit = lngFit + (1 * SingleByteWeight)
End If
'20-7E
If (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
lngFit = lngFit + (1 * SingleByteWeight)
End If
Case kana
'21-5F
If (bytCode(i) >= &H21 And bytCode(i) <= &H5F) Then
lngFit = lngFit + (1 * SingleByteWeight)
End If
Case kanO, kanN, kanH
If i <= UBound(bytCode) - 1 Then
'21-7E
If (bytCode(i) >= &H21 And bytCode(i) <= &H7E) And _
(bytCode(i - 1) >= &H21 And bytCode(i - 1) <= &H7E) Then
lngFit = lngFit + (2 * Multi_ByteWeight)
i = i + 1
End If
End If
End Select
End If
Next i
JudgeJIS = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function
'----EUC関係
' 関数名 : JudgeEUC
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : EUCの文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeEUC(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As 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
'8E(1バイト目) + A1-DF(2バイト目)
If bytCode(i) = &H8E Then
If i <= UBound(bytCode) - 1 Then
If bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HDF Then
lngFit = lngFit + (2 * Multi_ByteWeight)
i = i + 1
End If
End If
'8F(1バイト目) + A1-0xFE(2・3バイト目)
ElseIf bytCode(i) = &H8F Then
If i <= UBound(bytCode) - 2 Then
If (bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HFE) And _
(bytCode(i + 2) >= &HA1 And bytCode(i + 2) <= &HFE) Then
lngFit = lngFit + (3 * Multi_ByteWeight)
i = i + 2
End If
End If
'A1-FE(1バイト目) + A1-FE(2バイト目)
ElseIf bytCode(i) >= &HA1 And bytCode(i) <= &HFE Then
If i <= UBound(bytCode) - 1 Then
If bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HFE 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
JudgeEUC = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function
'----UNICODE関係
' 関数名 : JudgeUNI
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : UTF16の文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeUNI(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As 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
If fixFlag Then
'BOM
If bytCode(i) = &HFF Then
If i <= UBound(bytCode) - 1 Then
If bytCode(i + 1) = &HFE Then
JudgeUNI = JUDGEFIX
Exit Function
End If
End If
End If
'半角の証
'If bytCode(i) = &H0 Then
' JudgeUNI = JUDGEFIX
' Exit Function
'End If
End If
If i <= UBound(bytCode) - 1 Then
'00(2バイト目)
If (bytCode(i + 1) = &H0) Then
'00-FF(1バイト目)
lngFit = lngFit + (2 * Multi_ByteWeight)
'01-33(2バイト目)
ElseIf (bytCode(i + 1) >= &H1 And bytCode(i + 1) <= &H33) Then
'00-FF(1バイト目)
lngFit = lngFit + (2 * Multi_ByteWeight)
'34-4D(2バイト目)
ElseIf (bytCode(i + 1) >= &H34 And bytCode(i + 1) <= &H4D) Then
'00-FF(1バイト目)----空き----
lngFit = 0
Exit For
'4E-9F(2バイト目)
ElseIf (bytCode(i + 1) >= &H4E And bytCode(i + 1) <= &H9F) Then
'00-FF(1バイト目)
lngFit = lngFit + (2 * Multi_ByteWeight)
'A0-AB(2バイト目)
ElseIf (bytCode(i + 1) >= &HA0 And bytCode(i + 1) <= &HAB) Then
'00-FF(1バイト目)----空き----
lngFit = 0
Exit For
'AC-D7(2バイト目)
ElseIf (bytCode(i + 1) >= &HAC And bytCode(i + 1) <= &HD7) Then
'00-FF(1バイト目)----ハングル----
lngFit = 0
Exit For
'D8-DF(2バイト目)
ElseIf (bytCode(i + 1) >= &HD8 And bytCode(i + 1) <= &HDF) Then
'00-FF(1バイト目)
lngFit = lngFit + (2 * Multi_ByteWeight)
'E0-F7(2バイト目)
ElseIf (bytCode(i + 1) >= &HE0 And bytCode(i + 1) <= &HF7) Then
'00-FF(1バイト目)----外字----
lngFit = 0
Exit For
'F8-FF(2バイト目)
ElseIf (bytCode(i + 1) >= &HF8 And bytCode(i + 1) <= &HFF) Then
'00-FF(1バイト目)
lngFit = lngFit + (2 * Multi_ByteWeight)
End If
i = i + 1
End If
Next i
JudgeUNI = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function
'----UTF7関係
' 関数名 : JudgeUTF7
' 返り値 : 判定結果確率（％）
' 引き数 : bytCode : 判定文字データ
' : fixFlag : 確定判断有無
' 機能説明 : UTF7の文字コード判定(可能性)確率を計算する
' 備考 :
Private Function JudgeUTF7(ByRef bytCode() As Byte, _
Optional fixFlag As Boolean = False) As Integer
Dim i As Long
Dim lngFit As Long
Dim lngWrk As Long
Dim str64 As String
Dim bln64 As Boolean
str64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim lngUB As Long
Dim lngBY As Long
Dim lngXB As Long
Dim lngXX As Long
lngUB = JUDGESIZEMAX - 1
If lngUB > UBound(bytCode()) Then
lngUB = UBound(bytCode())
End If
lngWrk = 0
For i = 0 To lngUB
'+～-まではBASE64ENCODE
If bytCode(i) = Asc("+") And bln64 = False Then
lngWrk = 1
bln64 = True
ElseIf bytCode(i) = Asc("-") Then
If lngWrk <= 0 Then
lngWrk = lngWrk + 1
lngFit = lngFit + (lngWrk * SingleByteWeight)
ElseIf lngWrk = 1 Then
lngWrk = lngWrk + 1
lngFit = lngFit + (lngWrk * Multi_ByteWeight)
ElseIf lngWrk >= 4 And lngXB < 6 And _
((InStr(str64, Chr(bytCode(i - 1))) - 1) And lngXX) = 0 Then
lngWrk = lngWrk + 1
lngFit = lngFit + (lngWrk * Multi_ByteWeight)
End If
lngWrk = 0
bln64 = False
Else
If bln64 = True Then
'BASE64ENCODE中
If InStr(str64, Chr(bytCode(i))) > 0 Then
lngBY = Int((lngWrk * 6) / 8)
lngXB = (lngWrk * 6) - (lngBY * 8)
lngXX = (2 ^ lngXB) - 1
lngWrk = lngWrk + 1
Else
lngWrk = 0
bln64 = False
End If
Else
'20-7E(1バイト目)
If (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
End If
End If
Next i
JudgeUTF7 = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
End Function
'----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ステップイン（F８）で確認してみてください。
筆者オススメVBAの本はこちら↓↓
ExcelVBA学習のおすすめの本５選
筆者オススメの「これは秀逸！」「これは１冊持っとくべき」と思えるExcelVBAの本を紹介しています。ExcelVBAの書籍選びで、どれを選んでよいか迷っておられる方に参考にしていただきたいです。
ym-pc.com
2023.07.20
ADODB.ConnectionとADODB.Recordsetについての記事はこちら↓
ExcelVBAを使ったCSVデータの読込-ADO編-
ADO（ActiveX Data Objects）とSQLを使ったCSVファイルの読込の基本方法について紹介します。
ym-pc.com
2023.11.18
まとめ
今回は文字コードを指定してテキストファイルを読み込む方法と文字コードを自動判定して読み込む方法を紹介しました。
次回もVBAを使ったCSVテキストファイルの読込方法を紹介します。楽しみにお待ちください！
コメント