たまに「じゃんぬねっと」が生存確認をする日記

役員より労働者の方が絶対楽だと思う

ホーム 連絡をする 同期する ( RSS 2.0 ) Login
投稿数  984  : 記事  4  : コメント  36818  : トラックバック  277

ニュース

My Website

初心者向けのサイトです。

C# と VB.NET の入門サイト

最近のできごと

低学歴の IT エンジニア兼管理職です。ずっとリモートワーク中。

駆け出しはブラック企業で低年収でしたが、転職を繰り返して年収は 5 倍以上になりました。

年収はこれ以上増えても幸せ指数は増えませんので、趣味の時間を増やすため早期の半リタイアを考えています。

最高の配偶者、可愛い娘、ハンサムな息子と幸せな日々を送っています。

息子の将来の夢はゲーム実況者らしい。がんばれー^^。

Sponsored Link1

Sponsored Link2

Archive

書庫

前回の VBScript 版からの移植希望がありましたので、適当にコンバートしてみました。Scripting.Dictionary クラスから VBA.Collection クラスに置き換わっています。

VB (VB6) - CsvReader クラス

'/** CsvReader クラス */
Option Explicit

' EnumState 列挙体
Private Enum EnumState
    None = 0                '読み込み開始前
    Beginning = 1           '初期状態の入力待ち
    WaitInput = 2           '入力待ち
    FindQuote = 3           '引用符を発見
    FindQuoteDouble = 4     '引用符の連続を発見
    InQuote = 5             '引用符の中で入力待ち
    FindQuoteInQuote = 6    '引用符の中で引用符を発見
    FindComma = 7           'カンマを発見
    FindCr = 8              'Cr を発見
    FindCrLf = 9            'CrLf を発見
    Error = 255             'エラー発生
End Enum

' プロパティ変数
Private m_FilePath    As String
Private m_HasHeader   As Boolean
Private m_IgnoreError As Boolean

' Private フィールド
Private mTextStream As TextStream
Private mState      As EnumState
Private mHeaders    As Collection

' コンストラクタ
Private Sub Class_Initialize()
    mState = EnumState.Beginning
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Call Me.CloseStream
End Sub

' FilePath プロパティ - Getter
Public Property Get FilePath() As String
    Let FilePath = m_FilePath
End Property

' HasHeader プロパティ - Getter
Public Property Get HasHeader() As Boolean
    Let HasHeader = m_HasHeader
End Property

' IgnoreError プロパティ - Getter
Public Property Get IgnoreError() As Boolean
    Let IgnoreError = m_IgnoreError
End Property

' IgnoreError プロパティ - Setter
Public Property Let IgnoreError(ByVal Value As Boolean)
    m_IgnoreError = Value
End Property

' EndOfStream プロパティ
Public Property Get EndOfStream() As Boolean
    Let EndOfStream = mTextStream.AtEndOfStream
End Property

' OpenStream メソッド
Public Function OpenStream(ByVal stFilePath As String) As Boolean
    On Error GoTo Exception

    m_FilePath = stFilePath

    Dim cFso As FileSystemObject
    Set cFso = New FileSystemObject
    Set mTextStream = cFso.OpenTextFile(Me.FilePath)

    OpenStream = True
    Exit Function

Exception:
    Call Me.CloseStream
    OpenStream = False
End Function

' CloseStream メソッド
Public Sub CloseStream()
    If Not mTextStream Is Nothing Then
        On Error Resume Next
        Call mTextStream.Close
        On Error GoTo 0
    End If
End Sub

' ReadHeader メソッド
Public Function ReadHeader() As Collection
    Set mHeaders = Me.ReadLine()
    m_HasHeader = True
    Set ReadHeader = mHeaders
End Function

' ReadLine メソッド
Public Function ReadLine() As Collection
    Do While (True)
        Dim stReadLine As String
        stReadLine = stReadLine & mTextStream.ReadLine()

        Dim cRow As Collection
        Set cRow = ReadLineInternal(stReadLine)

        Select Case mState
            Case EnumState.FindQuote, EnumState.InQuote
                stReadLine = stReadLine & vbNewLine
            Case Else
                Exit Do
        End Select
    Loop

    Set ReadLine = cRow
End Function

' ReadToEnd メソッド
Public Function ReadToEnd() As Collection
    Dim cTable As Collection
    Set cTable = New Collection

    Dim stReadAll As String
    stReadAll = mTextStream.ReadAll()

    Dim stBuffers() As String
    stBuffers = Split(stReadAll, vbNewLine)

    Dim stReadLine As String
    Dim i          As Long
    Dim lIndex     As Long

    For i = LBound(stBuffers()) To UBound(stBuffers())
        stReadLine = stReadLine & stBuffers(i)

        Dim cRow As Collection
        Set cRow = ReadLineInternal(stReadLine)

        Select Case mState
            Case EnumState.FindQuote, EnumState.InQuote
                stReadLine = stReadLine & vbNewLine
            Case Else
                stReadLine = ""
                lIndex = lIndex + 1
                Call cTable.Add(cRow)
        End Select
    Next

    Set ReadToEnd = cTable
End Function

' 1 行読み込み
Private Function ReadLineInternal(ByVal stBuffer As String) As Collection
    Dim cRow As Collection
    Set cRow = New Collection

    mState = EnumState.Beginning

    Dim stItem As String
    Dim iIndex As Integer
    Dim iSeek  As Integer

    For iSeek = 1 To Len(stBuffer)
        Dim chNext As String
        chNext = Mid$(stBuffer, iSeek, 1)

        Select Case mState
            Case EnumState.Beginning
                stItem = ReadForStateBeginning(stItem, chNext)
            Case EnumState.WaitInput
                stItem = ReadForStateWaitInput(stItem, chNext)
            Case EnumState.FindQuote
                stItem = ReadForStateFindQuote(stItem, chNext)
            Case EnumState.FindQuoteDouble
                stItem = ReadForStateFindQuoteDouble(stItem, chNext)
            Case EnumState.InQuote
                stItem = ReadForStateInQuote(stItem, chNext)
            Case EnumState.FindQuoteInQuote
                stItem = ReadForStateFindQuoteInQuote(stItem, chNext)
        End Select

        Select Case mState
            Case EnumState.FindCrLf
                mState = EnumState.Beginning
                Exit For
            Case EnumState.FindComma
                iIndex = iIndex + 1
                Call AddRowItem(stItem, cRow, iIndex)
                mState = EnumState.Beginning
                stItem = ""
            Case EnumState.Error
                If Not Me.IgnoreError Then
                    Call Err.Raise(5, "ReadLineInternal", "書式が不正です。")
                End If

                mState = EnumState.WaitInput
        End Select
    Next

    If mState = EnumState.FindQuoteDouble Then
        stItem = stItem & """"
    End If

    iIndex = iIndex + 1
    Call AddRowItem(stItem, cRow, iIndex)
    Set ReadLineInternal = cRow
End Function

' 初回入力待ち状態での Read
Private Function ReadForStateBeginning(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case vbCr
            mState = EnumState.FindCr
        Case ","
            mState = EnumState.FindComma
        Case """"
            mState = EnumState.FindQuote
        Case Else
            mState = EnumState.WaitInput
            stItem = stItem & chNext
    End Select

    Let ReadForStateBeginning = stItem
End Function

' 入力待ち状態での Read
Private Function ReadForStateWaitInput(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case vbCr
            mState = EnumState.FindCr
        Case ","
            mState = EnumState.FindComma
        Case """"
            mState = EnumState.FindQuote
        Case Else
            stItem = stItem & chNext
    End Select

    Let ReadForStateWaitInput = stItem
End Function

' 引用符を発見した状態での Read
Private Function ReadForStateFindQuote(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case """"
            mState = EnumState.FindQuoteDouble
        Case Else
            mState = EnumState.InQuote
            stItem = stItem & chNext
    End Select

    Let ReadForStateFindQuote = stItem
End Function

' 引用符の連続を発見した状態での Read
Private Function ReadForStateFindQuoteDouble(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case vbCr
            mState = EnumState.FindCr
            stItem = stItem & """"
        Case ","
            mState = EnumState.FindComma
            stItem = stItem & """"
        Case """"
            mState = EnumState.FindQuote
            stItem = stItem & """"
        Case Else
            mState = EnumState.WaitInput
            stItem = stItem & """" & chNext
    End Select

    ReadForStateFindQuoteDouble = stItem
End Function

' 引用符の中で入力待ち状態での Read
Private Function ReadForStateInQuote(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case """"
            mState = EnumState.FindQuoteInQuote
        Case Else
            stItem = stItem & chNext
    End Select

    Let ReadForStateInQuote = stItem
End Function

' 引用符の中で引用符を発見した状態での Read
Private Function ReadForStateFindQuoteInQuote(ByVal stItem As String, ByVal chNext As String) As String
    Select Case chNext
        Case vbCr
            mState = EnumState.FindCr
        Case ","
            mState = EnumState.FindComma
        Case """"
            mState = EnumState.InQuote
            stItem = stItem & """"
        Case Else
            mState = EnumState.Error
    End Select

    Let ReadForStateFindQuoteInQuote = stItem
End Function

' Row にアイテムを入れる
Private Sub AddRowItem(ByVal stItem As String, ByVal cRow As Collection, ByVal lIndex As Long)
    If Me.HasHeader Then
        Call cRow.Add(stItem, mHeaders(lIndex))
    Else
        Call cRow.Add(stItem)
    End If
End Sub

使用例となるサンプルコードを以下に示します。

VB (VB6) - CSV 読み込みクラス 使用例 1

Private Sub MosaMosaAA()
    Dim cCsvReader As CsvReader
    Set cCsvReader = New CsvReader

    ' 指定した CSV ファイルを開く
    Call cCsvReader.OpenStream("C:\MakiMaki.csv")

    ' CSV ファイルの中身をすべて取得する
    Dim cTable As Collection
    Set cTable = cCsvReader.ReadToEnd()

    ' すべての中身 (Table) から 行 (Row) を列挙して取り出す
    Dim cRow As Collection
    For Each cRow In cTable
        Dim i As Integer

        ' 行から添え字を使って各 Item を出力する
        For i = 1 To cRow.Count()
            Debug.Print cRow(i)
        Next

        Debug.Print vbNewLine
    Next
End Sub

ReadHeader メソッドを使用すると、各 Item にカラム名からアクセスすることができます。

VB (VB6) - CSV 読み込みクラス 使用例 2

Private Sub MosaMosaAA()
    Dim cCsvReader As CsvReader
    Set cCsvReader = New CsvReader

    ' 指定した CSV ファイルを開く
    Call cCsvReader.OpenStream("C:\MakiMaki.csv")

    ' 最初の行をヘッダとして読み込む
    Call cCsvReader.ReadHeader

    ' CSV ファイルの中身をすべて取得する
    Dim cTable As Collection
    Set cTable = cCsvReader.ReadToEnd()

    ' すべての中身 (Table) から 行 (Row) を列挙して取り出す
    Dim cRow As Collection
    For Each cRow In cTable
        ' 行からカラム名を使って各 Item を出力する
        Debug.Print cRow("社員番号")
        Debug.Print cRow("社員名")
        Debug.Print cRow("住所")
        Debug.Print cRow("電話番号")
        Debug.Print
    Next
End Sub

サンプルでは ReadToEnd メソッドを使って一気に全部読み込んでいますが、ReadLine メソッドを使うと 1 行ずつ読むことができます。

なるべく RFC に準拠するように努めましたが、自己都合でいくつかカスタマイズが入っています。一応、状況によって処理が細かく分かれているので、カスタマイズはそこそこ容易だと思います。

関連リンク

投稿日時 : 2007年4月27日 10:49

コメント

# re: VB (VB6) - CSV ファイルを読み込む CsvReader クラス 2007/04/27 13:33 じゃんぬねっと
区切り文字もプロパティにした方が良いですね。
あー、忘れてた。

# doxycycline 100mg capsules https://doxycyline1st.com/
doxycycline 200 mg 2022/02/26 10:17 Jusidkid
doxycycline 100mg capsules https://doxycyline1st.com/
doxycycline 200 mg

# stromectol 3 mg for scabies https://stromectolbestprice.com/ 2022/07/30 1:06 BestPrice
stromectol 3 mg for scabies https://stromectolbestprice.com/

Post Feedback

タイトル
名前
Url:
コメント: