CSV ファイルを読みたかったので、何となく作ってみました。
VBScript - CsvReader クラス
'/** CsvReader クラス */
Option Explicit
Class CsvReader
' プロパティ変数
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 Dictionary
' 列挙体の代わり
Private EnumState 'As EnumStateConstants
' コンストラクタ
Private Sub Class_Initialize()
Set EnumState = New EnumStateConstants
mState = EnumState.None
End Sub
' デストラクタ
Private Sub Class_Terminate()
Call Me.CloseStream()
End Sub
' FilePath プロパティ - Getter
Public Property Get FilePath() 'As String
FilePath = m_FilePath
End Property
' HasHeader プロパティ - Getter
Public Property Get HasHeader() 'As Boolean
HasHeader = m_HasHeader
End Property
' IgnoreError プロパティ - Getter
Public Property Get IgnoreError() 'As Boolean
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
EndOfStream = mTextStream.AtEndOfStream
End Property
' OpenStream メソッド
Public Function OpenStream(ByVal stFilePath) 'As Boolean
On Error Resume Next
m_FilePath = stFilePath
Dim cFso 'As FileSystemObject
Set cFso = WScript.CreateObject("Scripting.FileSystemObject")
Set mTextStream = cFso.OpenTextFile(Me.FilePath)
If Err.Number = 0 Then
OpenStream = True
Exit Function
End If
Call Me.CloseStream()
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 Dictionary
Set mHeaders = Me.ReadLine()
m_HasHeader = True
Set ReadHeader = mHeaders
End Function
' ReadLine メソッド
Public Function ReadLine() 'As Dictionary
Do While (True)
Dim stReadLine 'As String
stReadLine = stReadLine & mTextStream.ReadLine()
Dim cRow 'As Dictionary
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 Dictionary
Dim cTable 'As Dictionary
Set cTable = WScript.CreateObject("Scripting.Dictionary")
Dim stReadAll 'As String
stReadAll = mTextStream.ReadAll()
Dim stReadLines 'As String
stReadLines = Split(stReadAll, vbNewLine)
Dim stReadLine 'As String
Dim i 'As Integer
Dim iIndex 'As Integer
For i = LBound(stReadLines) To UBound(stReadLines)
stReadLine = stReadLine & stReadLines(i)
Dim cRow 'As Dictionary
Set cRow = ReadLineInternal(stReadLine)
Select Case mState
Case EnumState.FindQuote, EnumState.InQuote
stReadLine = stReadLine & vbNewLine
Case Else
stReadLine = ""
iIndex = iIndex + 1
Call cTable.Add(iIndex, cRow)
End Select
Next
Set ReadToEnd = cTable
End Function
' 1 行読み込み
Private Function ReadLineInternal(ByVal stBuffer) 'As Dictionary
Dim cRow 'As Dictionary
Set cRow = WScript.CreateObject("Scripting.Dictionary")
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
Call AddRowItem(stItem, cRow, iIndex)
mState = EnumState.Beginning
stItem = ""
iIndex = iIndex + 1
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
Call AddRowItem(stItem, cRow, iIndex)
Set ReadLineInternal = cRow
End Function
' 初回入力待ち状態での Read
Private Function ReadForStateBeginning(ByVal stItem, ByVal chNext) '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
ReadForStateBeginning = stItem
End Function
' 入力待ち状態での Read
Private Function ReadForStateWaitInput(ByVal stItem, ByVal chNext) '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
ReadForStateWaitInput = stItem
End Function
' 引用符を発見した状態での Read
Private Function ReadForStateFindQuote(ByVal stItem, ByVal chNext) 'As String
Select Case chNext
Case """"
mState = EnumState.FindQuoteDouble
Case Else
mState = EnumState.InQuote
stItem = stItem & chNext
End Select
ReadForStateFindQuote = stItem
End Function
' 引用符の連続を発見した状態での Read
Private Function ReadForStateFindQuoteDouble(ByVal stItem, ByVal chNext) '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, ByVal chNext) 'As String
Select Case chNext
Case """"
mState = EnumState.FindQuoteInQuote
Case Else
stItem = stItem & chNext
End Select
ReadForStateInQuote = stItem
End Function
' 引用符の中で引用符を発見した状態での Read
Private Function ReadForStateFindQuoteInQuote(ByVal stItem, ByVal chNext) '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
ReadForStateFindQuoteInQuote = stItem
End Function
' Row にアイテムを入れる
Private Sub AddRowItem(ByVal stItem, ByVal cRow, ByVal iIndex)
If Me.HasHeader Then
Call cRow.Add(mHeaders(iIndex), stItem)
Else
Call cRow.Add(iIndex, stItem)
End If
End Sub
End Class
VBScript - EnumStateConstants クラス
'/** EnumState 列挙体 */
Option Explicit
Class EnumStateConstants
Private m_None '読み込み開始前
Private m_Beginning '初期状態の入力待ち
Private m_WaitInput '入力待ち
Private m_FindQuote '引用符を発見
Private m_FindQuoteDouble '引用符の連続を発見
Private m_InQuote '引用符の中で入力待ち
Private m_FindQuoteInQuote '引用符の中で引用符を発見
Private m_FindComma 'カンマを発見
Private m_FindCr 'Cr を発見
Private m_FindCrLf 'CrLf を発見
Private m_Error 'エラー発生
Private Sub Class_Initialize()
m_None = 0
m_Beginning = 1
m_WaitInput = 2
m_FindQuote = 3
m_FindQuoteDouble = 4
m_InQuote = 5
m_FindQuoteInQuote = 6
m_FindComma = 7
m_FindCr = 8
m_FindCrLf = 9
m_Error = 255
End Sub
' None プロパティ - Getter
Public Property Get None()
None = m_None
End Property
' Beginning プロパティ - Getter
Public Property Get Beginning()
Beginning = m_Beginning
End Property
' WaitInput プロパティ - Getter
Public Property Get WaitInput()
WaitInput = m_WaitInput
End Property
' FindQuote プロパティ - Getter
Public Property Get FindQuote()
FindQuote = m_FindQuote
End Property
' FindQuote プロパティ - Getter
Public Property Get FindQuoteDouble()
FindQuoteDouble = m_FindQuoteDouble
End Property
' InQuote プロパティ - Getter
Public Property Get InQuote()
InQuote = m_InQuote
End Property
' FindQuoteInQuote プロパティ - Getter
Public Property Get FindQuoteInQuote()
FindQuoteInQuote = m_FindQuoteInQuote
End Property
' FindComma プロパティ - Getter
Public Property Get FindComma()
FindComma = m_FindComma
End Property
' FindCr プロパティ - Getter
Public Property Get FindCr()
FindCr = m_FindCr
End Property
' FindCrLf プロパティ - Getter
Public Property Get FindCrLf()
FindCrLf = m_FindCrLf
End Property
' Error プロパティ - Getter
Public Property Get Error()
Error = m_Error
End Property
End Class
使用例となるサンプルコードを以下に示します。
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 Dictionary
Set cTable = cCsvReader.ReadToEnd()
Dim stPrompt 'As String
stPrompt = ""
' すべての中身 (Table) から 行 (Row) を列挙して取り出す
Dim cRow 'As Dictionary
For Each cRow In cTable.Items()
Dim i 'As Integer
' 行から添え字を使って各 Item を文字列として結合する
For i = 1 To cRow.Count
stPrompt = stPrompt & CStr(cRow(i)) & vbTab
Next
stPrompt = stPrompt & vbNewLine
Next
' 結合結果を出力する
Call MsgBox(stPrompt)
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 Dictionary
Set cTable = cCsvReader.ReadToEnd()
Dim stPrompt 'As String
stPrompt = ""
' すべての中身 (Table) から 行 (Row) を列挙して取り出す
Dim cRow 'As Dictionary
For Each cRow In cTable.Items()
' 行からカラム名を使って各 Item を文字列として結合する
stPrompt = stPrompt & CStr(cRow("社員番号")) & vbTab
stPrompt = stPrompt & CStr(cRow("社員名")) & vbTab
stPrompt = stPrompt & CStr(cRow("住所")) & vbTab
stPrompt = stPrompt & CStr(cRow("電話番号")) & vbNewLine
Next
' 結合結果を出力する
Call MsgBox(stPrompt)
End Sub
サンプルでは ReadToEnd メソッドを使って一気に全部読み込んでいますが、ReadLine メソッドを使うと 1 行ずつ読むことができます。
なるべく RFC に準拠するように努めましたが、自己都合でいくつかカスタマイズが入っています。一応、状況によって処理が細かく分かれているので、カスタマイズはそこそこ容易だと思います。
関連リンク