Takenoff Labs

（2017/10/16 全面的に書き換えました）

CSVの規則によると、引用符（ダブルクォーテーション）内では、改行を入れていいことになっています。が、Line Input では改行までを1行として読み込むので、これに対応しようと思うとちょっと面倒なことになります。そんな面倒を解消するため、手軽に扱える関数を作ってみました。

※CSVのルールに反したデータは想定していません。より厳密にやるなら、エラーチェックなどを入れてください。

ソースコード

Public Function GetCSVLine(ByVal intFno As Integer, _
ByVal strDelim As String, ByVal strQuote As String) As Variant
    Dim strCsv   As String
    Dim strRet() As String
    Dim strBuf   As String
    Dim bln1st   As Boolean
    Dim blnQuote As Boolean
    
    strBuf = ""
    bln1st = True
    
    Do
        If EOF(intFno) Then
            If strBuf <> "" Then
                Call AryPush(strRet, strBuf)
            End If
            Exit Do
        End If
        
        Line Input #intFno, strCsv
        
        Do Until strCsv = ""
            Select Case Left(strCsv, 1)
            Case strQuote
                If bln1st = True Then
                    blnQuote = True
                    bln1st   = False
                Else
                    If blnQuote = True Then
                        If Left(strCsv, 2) = strQuote & strQuote Then
                            strBuf = strBuf & strQuote
                            strCsv = Mid(strCsv, 2)
                        Else
                            blnQuote = False
                        End If
                    Else
                        strBuf = strBuf & strQuote
                    End If
                End If
            Case strDelim
                If blnQuote = True Then
                    strBuf = strBuf & strDelim
                Else
                    Call AryPush(strRet, strBuf)
                    strBuf = ""
                    bln1st = True
                End If
            Case Else
                strBuf = strBuf & Left(strCsv, 1)
                bln1st = False
            End Select
            strCsv = Mid(strCsv, 2)
        Loop
        
        If blnQuote = True Then
            strBuf = strBuf & Chr(13) & Chr(10)
        ElseIf strBuf <> "" Then
            Call AryPush(strRet, strBuf)
        End If
        
    Loop Until blnQuote = False
    
    If AryIsUninit(strRet) = True Then
        Call AryPush(strRet, "")
    End If
    
    GetCSVLine = strRet
End Function

Public Sub AryPush(varAry As Variant, varVal As Variant)
    Dim intMax As Integer
    
    If IsArray(varAry) = False Then
        Exit Sub
    End If
    
    On Error GoTo ERR_INIT
    intMax = UBound(varAry) + 1
    On Error GoTo 0
    
    ReDim Preserve varAry(intMax)
    varAry(intMax) = varVal
    Exit Sub
    
ERR_INIT:
    intMax = 0
    ReDim varAry(0)
    Resume Next
End Sub

Public Function AryIsUninit(varAry As Variant) As Boolean
    Dim intMin As Integer
    
    On Error GoTo ERR_INIT
    intMin = LBound(varAry)
    On Error GoTo 0
    
    AryIsUninit = False
    Exit Function
    
ERR_INIT:
    AryIsUninit = True
    Exit Function
End Function

使い方

Dim varAry As Variant
Dim intFno As Integer
intFno = FreeFile()
Open "C:\test.csv" For Input As #intFno
Do Until EOF(intFno)
    varAry = GetCSVLine(intFno, ",", |"|)
    '処理
Loop
Close #intFno

(No Ratings Yet)

読み込み中...

トラックバックURL :