テキストファイルの区切り文字・改行コード・文字コードを取得

このマクロは、以下を参考に、改造しています。

特に、「Function JudgeCode」とこの関数から呼び出している関数は変更していません。

以下のマクロは、指定したテキストファイルから区切り文字、改行コード、文字コードを検出するためのものです。

'****************************************************************************
'JudgeCodeの戻り値だけ改変させてもらってします
'その他のコードは下記を参照させていただきました。
'http://nonsoft.la.coocan.jp/SoftSample/SampleModJUDG.html
'****************************************************************************

'****************************************************************************
' 機能名    : 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  '1バイト 文字コードの一致重み
Private Const Multi_ByteWeight = 2  '複数バイト文字コードの一致重み
Private Enum JISMODE                'JISコードのモード
    ctrl = 0                        '制御コード
    asci = 1                        'ASCII
    roma = 2                        'JISローマ字
    kana = 3                        'JISカナ(半角カナ)
    kanO = 4                        '旧JIS漢字 (1978)
    kanN = 5                        '新JIS漢字 (1983/1990)
    kanH = 6                        'JIS補助漢字
End Enum

'----文字コード判定
' 関数名    : 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
    
    
    Stop
    
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


' https://vbaexcel.slavesystems.com/vba/?p=1193


'****************************************************************************
'以下のコードは自分のオリジナルになります
'****************************************************************************



' テキストファイルの区切り文字・改行コード・文字コードを取得する
Sub 使用例1()
    Dim filePath As String
    filePath = "C:\Users\kengo.komatsu\Downloads\20240510受領\ANSI出品詳細レポート+05-10-2024.txt"
    
    ' 改行コード・文字コード・区切り文字を取得
    Dim arr As Variant
    arr = GetCode(filePath)
    
    Dim message As String
    message = "区切り文字:" & arr(1)
    message = message & vbCrLf & "改行コード:" & arr(2)
    message = message & vbCrLf & "文字コード:" & arr(3)
    MsgBox (message)

End Sub

'*******************************************
'* 区切り文字・改行コード・文字コードを配列で返す
'* GetCode(1):区切り文字:Comma, Tab
'* GetCode(2):改行コード:CRLF, CR, LF
'* GetCode(3):文字コード:Shift_JIS, UTF-8, Unicode, JIS, UTF-7, euc-jp
'* filePath:ファイルパス名
Function GetCode(ByVal filePath) As Variant

    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
    
    Dim tempArr As Variant
    ReDim tempArr(1 To 3)
    
    ' 区切り文字を取得。"Comma", "Tab"に対応。それ以外は、マクロ終了
    tempArr(1) = JugeDelimiter(bytCode)
    ' 改行コードを取得。"CRLF", "CR", "LF" に対応。それ以外はマクロ終了。
    tempArr(2) = JugeNewlineCode(bytCode)
    ' 文字コードを取得。Shift_JIS, UTF-8, Unicode, JIS, UTF-7, euc-jp に対応。
    tempArr(3) = JudgeCode(bytCode)

    GetCode = tempArr

End Function

'*******************************************
'* JugeDelimiter:区切り文字。"Comma", "Tab"に対応。それ以外は、マクロ終了
'* bytCode : 判定文字データ
Function JugeDelimiter(ByRef bytCode() As Byte) As String

    Dim anser As String ' 区切り文字の結果を格納する変数
    Dim i As Long ' ループ変数
    
    ' 「bytCode」の最初から最後まで繰り返す
    For i = LBound(bytCode) To UBound(bytCode)
        If bytCode(i) = 44 Then ' ASCIIコード44はカンマに対応しています
            anser = "Comma" ' カンマを区切り文字として判定
            Exit For ' ループを終了
        ElseIf bytCode(i) = 9 Then ' ASCIIコード9はタブに対応しています
            anser = "Tab" ' タブを区切り文字として判定
            Exit For ' ループを終了
        End If
    Next i
    
    If anser <> "" Then ' 区切り文字が判定された場合
        JugeDelimiter = anser ' 判定結果を返す
    Else
        ' 区切り文字が見つからない場合はメッセージを表示
        MsgBox "区切り文字(カンマ・タブ)が見つかりませんでした。マクロを終了します"
        End ' マクロの実行を終了
    End If
End Function

'*******************************************
'* JugeNewlineCode:改行コード。"CRLF", "CR", "LF" に対応。それ以外はマクロ終了。
'* bytCode : 判定文字データ
'* LF:10(UNIX), CRLF:13 10(Windows), CR:13(Macintosh)
Function JugeNewlineCode(ByRef bytCode() As Byte) As String

    Dim anser As String ' 改行コードの結果を格納する変数
    Dim i As Long ' ループ変数
    
    ' 「bytCode」の最初から最後まで繰り返す
    For i = LBound(bytCode) To UBound(bytCode)
        If bytCode(i) = 13 Then ' ASCIIコード13はCRに対応しています
            If bytCode(i + 1) = 10 Then ' 次の文字がASCIIコード10(LF)であればCRLFと判定
                anser = "CRLF" ' CRLFを改行コードとして判定
            Else
                anser = "CR" ' CRを改行コードとして判定
            End If
            Exit For ' ループを終了
        ElseIf bytCode(i) = 10 Then ' ASCIIコード10はLFに対応しています
            anser = "LF" ' LFを改行コードとして判定
            Exit For ' ループを終了
        End If
    Next i
    
    If anser <> "" Then ' 改行コードが判定された場合
        JugeNewlineCode = anser ' 判定結果を返す
    Else
        ' 改行コードが見つからない場合はメッセージを表示
        MsgBox "改行コードが見つかりませんでした。マクロを終了します"
        End ' マクロの実行を終了
    End If
End Function

それぞれの関数の役割とその動作を詳しく解説します。

使用例1

' テキストファイルの区切り文字・改行コード・文字コードを取得する
Sub 使用例1()
    Dim filePath As String
    filePath = "C:\Users\kengo.komatsu\Downloads\20240510受領\ANSI出品詳細レポート+05-10-2024.txt"
    
    ' 改行コード・文字コード・区切り文字を取得
    Dim arr As Variant
    arr = GetCode(filePath)
    
    Dim message As String
    message = "区切り文字:" & arr(1)
    message = message & vbCrLf & "改行コード:" & arr(2)
    message = message & vbCrLf & "文字コード:" & arr(3)
    MsgBox (message)

End Sub
  • filePath に対象ファイルのパスを指定します。
  • GetCode 関数を呼び出して、区切り文字、改行コード、文字コードを取得します。
  • 結果をメッセージボックスで表示します。

GetCode 関数

'*******************************************
'* 区切り文字・改行コード・文字コードを配列で返す
'* GetCode(1):区切り文字:Comma, Tab
'* GetCode(2):改行コード:CRLF, CR, LF
'* GetCode(3):文字コード:Shift_JIS, UTF-8, Unicode, JIS, UTF-7, euc-jp
'* filePath:ファイルパス名
Function GetCode(ByVal filePath) As Variant

    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
    
    Dim tempArr As Variant
    ReDim tempArr(1 To 3)
    
    ' 区切り文字を取得。"Comma", "Tab"に対応。それ以外は、マクロ終了
    tempArr(1) = JugeDelimiter(bytCode)
    ' 改行コードを取得。"CRLF", "CR", "LF" に対応。それ以外はマクロ終了。
    tempArr(2) = JugeNewlineCode(bytCode)
    ' 文字コードを取得。Shift_JIS, UTF-8, Unicode, JIS, UTF-7, euc-jp に対応。
    tempArr(3) = JudgeCode(bytCode)

    GetCode = tempArr

End Function
  • ADODB.Stream オブジェクトを使用して、指定したファイルをバイナリモードで読み込みます。
  • バイト配列 bytCode にファイル内容を格納します。
  • JugeDelimiter, JugeNewlineCode, JudgeCode 関数を呼び出して、区切り文字、改行コード、文字コードを判定し、結果を tempArr 配列に格納します。
  • 判定結果を配列として返します。

JugeDelimiter 関数

'*******************************************
'* JugeDelimiter:区切り文字。"Comma", "Tab"に対応。それ以外は、マクロ終了
'* bytCode : 判定文字データ
Function JugeDelimiter(ByRef bytCode() As Byte) As String

    Dim anser As String ' 区切り文字の結果を格納する変数
    Dim i As Long ' ループ変数
    
    ' 「bytCode」の最初から最後まで繰り返す
    For i = LBound(bytCode) To UBound(bytCode)
        If bytCode(i) = 44 Then ' ASCIIコード44はカンマに対応しています
            anser = "Comma" ' カンマを区切り文字として判定
            Exit For ' ループを終了
        ElseIf bytCode(i) = 9 Then ' ASCIIコード9はタブに対応しています
            anser = "Tab" ' タブを区切り文字として判定
            Exit For ' ループを終了
        End If
    Next i
    
    If anser <> "" Then ' 区切り文字が判定された場合
        JugeDelimiter = anser ' 判定結果を返す
    Else
        ' 区切り文字が見つからない場合はメッセージを表示
        MsgBox "区切り文字(カンマ・タブ)が見つかりませんでした。マクロを終了します"
        End ' マクロの実行を終了
    End If
End Function
  • バイト配列 bytCode をループし、カンマ(ASCIIコード44)またはタブ(ASCIIコード9)を検出します。
  • 見つかった場合は、それぞれ Comma または Tab を返します。
  • 見つからなかった場合は、メッセージボックスを表示してマクロを終了します。

JugeNewlineCode 関数

'*******************************************
'* JugeNewlineCode:改行コード。"CRLF", "CR", "LF" に対応。それ以外はマクロ終了。
'* bytCode : 判定文字データ
'* LF:10(UNIX), CRLF:13 10(Windows), CR:13(Macintosh)
Function JugeNewlineCode(ByRef bytCode() As Byte) As String

    Dim anser As String ' 改行コードの結果を格納する変数
    Dim i As Long ' ループ変数
    
    ' 「bytCode」の最初から最後まで繰り返す
    For i = LBound(bytCode) To UBound(bytCode)
        If bytCode(i) = 13 Then ' ASCIIコード13はCRに対応しています
            If bytCode(i + 1) = 10 Then ' 次の文字がASCIIコード10(LF)であればCRLFと判定
                anser = "CRLF" ' CRLFを改行コードとして判定
            Else
                anser = "CR" ' CRを改行コードとして判定
            End If
            Exit For ' ループを終了
        ElseIf bytCode(i) = 10 Then ' ASCIIコード10はLFに対応しています
            anser = "LF" ' LFを改行コードとして判定
            Exit For ' ループを終了
        End If
    Next i
    
    If anser <> "" Then ' 改行コードが判定された場合
        JugeNewlineCode = anser ' 判定結果を返す
    Else
        ' 改行コードが見つからない場合はメッセージを表示
        MsgBox "改行コードが見つかりませんでした。マクロを終了します"
        End ' マクロの実行を終了
    End If
End Function
  • バイト配列 bytCode をループし、CR(ASCIIコード13)またはLF(ASCIIコード10)を検出します。
  • CRと続くLFのペアが見つかった場合は CRLF として判定し、CR単独であれば CR、LF単独であれば LF として判定します。
  • 見つからなかった場合は、メッセージボックスを表示してマクロを終了します。

JudgeCode 関数

この関数は、このページの頭に掲載していますが、以下から引用しています。

http://nonsoft.la.coocan.jp/SoftSample/SampleModJUDG.html

マクロ全体の流れ

  1. 使用例1 サブルーチンで、ファイルのパスを指定し、GetCode 関数を呼び出します。
  2. GetCode 関数はファイルをバイナリモードで読み込み、バイト配列 bytCode に格納します。
  3. JugeDelimiter 関数で区切り文字を判定し、カンマまたはタブを返します。それ以外はエラーメッセージを表示して終了します。
  4. JugeNewlineCode 関数で改行コードを判定し、CRLF、CR、LF のいずれかを返します。それ以外はエラーメッセージを表示して終了します。
  5. JudgeCode 関数で文字コードを判定し、UTF-8、Unicode、Shift_JIS などを返します。
  6. これらの判定結果を配列に格納し、GetCode 関数が戻り値として返します。
  7. 使用例1 サブルーチンで、取得した判定結果をメッセージボックスで表示します。

Follow me!