ExcelVBAを使ったCSVデータの読み込み まとめ③

Excel
スポンサーリンク

VBAを使用したCSVデータの一括読み込み方法について備忘録的に紹介していきたいと思います。

今回は紹介する内容は以下の2つです。

  1. 文字コードを指定してCSVデータを読み込む方法
  2. 文字コードを自動判定して読み込む方法

前回までの記事について

のCSV読込のためのOpenステートメント、Line Input #ステートメントを使ったコードを紹介した記事はこちら。

ExcelVBAを使ったCSVデータの読み込み まとめ①
VBAを使用したCSVデータの一括読み込み方法について紹介しています。

②のファイルシステムオブジェクトのText Streamオブジェクトを使った方法を紹介した記事はこちら。

ExcelVBAを使ったCSVデータの読み込み まとめ②
ファイルシステムオブジェクトのText Streamオブジェクトを使った方法を紹介します。
スポンサーリンク

文字コードとは

文字に割り振られた番号の事で、ASCIIコード、JISコード、Shift-JIS、UTF-8などがあります。詳しい記事を見つけたのでそちらを参考にしてください。

unicodeとは?文字コードとは?UTF-8とは? - Qiita
 はじめに タイトルにある通り、文字コードについて学習したことを記載していきたいと思います。  文字コードとは 数字しか認識できないコンピュータが文字を扱うために、人間の文字に対応してそれぞれ割り振られた番号のこと。 つま...

文字コードを指定して読み込む

これまで紹介したテキストファイル形式のCSVデータの読み込みは、すべて文字コードはShift-JISでした。

Shift-JISの場合は基本的には文字化けしないので、特に文字コードを指定する必要はありませんでした。

しかし、例えばWindowsのメモ帳に直接文字を入力すると、文字コードはデフォルトでUTF-8(BOMなし)になっていると思います。

これをそのままマクロでエクセルに読み込むと文字化けが発生してしまいます。

文字化け

文字コードを指定してテキストファイル3つを一括してエクセルに読み込む

それでは、VBAを使って文字化けすることなく、UTF-8のカンマ区切りテキストファイルの3ファイルを一括してエクセルに読み込んでみたいと思います。(インプット先のエクセル(CSV連結マクロ.xlsm)と同一フォルダ内の「うまい棒一覧データ」(_10日まで、_20日まで、_30日までの3ファイル)を連続して読み込みます。

フォルダ内のファイル

UTF-8のカンマ区切りテキストファイルは、下のような内容でそれぞれ10日まで、20日まで、30日までのデータが入っています。

ファイルの内容

エクセルへの読込

読込

大まかなコードの流れ(方法)

  1. ADODB.Streamオブジェクト(ActiveX Data Object)の生成
  2. Dir関数を使って、同一フォルダ内のテキストファイルを順番に取得
  3. ADODB.Streamオブジェクトで文字コードを指定したうえでファイルを読み込む
  4. ファイルの中身を一行ずつ読み込んだものを変数に格納
  5. 格納したデータをカンマごとに配列変数に格納
  6. エクセルシートにエクスポート

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

ADODBの参照設定を行わない場合

事前に参照設定を行わない場合は、CreateObject関数を使います。その場合

Dim ADOst as Object

Set ADOst = CreateObject(“ADODB.Stream”)

となります。遅延バインディング(実行時バインディング)と言います。

一方の「参照設定」は事前バインディングを言います。

Dir関数

ファイルが存在するかどうかを判定する関数でファイル名を返します。


file = Dir(ThisWorkbook.path & "\*.txt", vbNormal) '同一フォルダ内のテキストファイルを取得

引数に*.txt(ワイルドカード)と入力することで、フォルダ内の全てのテキストファイルを返してくれます。(引数にはフルパスを入力しますが、返り値はフルパスではなく、あくまでファイル名のみです。)

詳細はこちらの過去記事にあります。

ExcelVBAを使ったCSVデータの読み込み まとめ①
VBAを使用したCSVデータの一括読み込み方法について紹介しています。

ADODBオブジェクトのプロパティやメソッド~その1~


ADOst.charSet = "UTF-8" '文字コードを指定
ADOst.Open 'STREAMオブジェクトを開きます。
ADOst.LoadFromFile path & file  'ファイルのデータをSTREAMに読み込む

プロパティやメソッド説明
Charsetプロパティテキストファイルの文字コードを指定します。”UTF-8”、”Shift-JIS”、”Unicoad”など
OpenメソッドStreamオブジェクトを開きます。「開く」とはデータを操作する状態を開始するようなイメージ
LoadFromFileメソッド引数で指定したパスのファイルをStreamに読み込む
CloseメソッドStreamオブジェクトを閉じます。
ExcelVBA脱初心者のための集中講座/たてばやし淳(著)より引用

つまり、Charsetプロパティで”UTF-8″を指定することで、文字コード:UTF-8のファイルを文字化けすることなく読み込むことが出来ます。

ADODBオブジェクトのプロパティやメソッド~その2~


Do Until ADOst.EOS
    
buf = ADOst.ReadText(-2) '一行づつ変数に格納(STREAMからデータを読み込む)-2はadreadlineでも可

EOSはテキストファイルの終端という意味なので、「テキストファイルの終端までループ」という意味になります。

ReadTextメソッド

Streamオブジェクトから1行または全文を返します。

Readtext(-1)・・Streamから全文を返します。引数を省略した場合、こちらが規定になります。

Readtext(-2)・・Streamから1行を返します。

その他コード

以降のコードについては、ExcelVBAを使ったCSVデータの読み込み まとめ①に記載したコードの流れと一緒なので割愛します。

注意としては、ADODB.Streamオブジェクトは、Dir関数で次のファイルに移行する前にCloseさせておく必要があります。1ファイルずつ閉じてから次に行くというイメージです。

文字コードを自動判定して読み込む方法

続いては同じフォルダ内にそれぞれ違う文字コードのファイルが存在する場合、それらを一括して読み込む方法をご紹介します。

フォルダ内

上のように、フォルダの中のファイルの文字コードが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%完璧な文字コード判定は難しいですが出来るだけ精度の高い判定を目指しています。
【VBA】文字コードを判定してファイルを読み込む
VBAでCSVファイルなどのファイル読み込みをする際に、そのファイルの文字コードが不明な場合でも、文字コード判別して読み込めるようにしたいと思いました。 外部システムから連携されてくるデータなどは文字コードが決まっているので問題ないケースが多いですが、ユーザが作ったファイルはどの文字コードで登録されているかわからないた...

文字コードを自動判定してフォルダ内テキストファイル一括読み込み

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)'JudgeCodeプロシージャへ(引数:ファイルのバイナリデータ)文字コードを判定
                                '返り値:判定された文字コード
    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

ステップイン(F8)で確認してみてください。

まとめ

今回は文字コードを指定してテキストファイルを読み込む方法文字コードを自動判定して読み込む方法を紹介しました。

次回もVBAを使ったCSVテキストファイルの読込方法を紹介します。楽しみにお待ちください!

コメント

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