作成 2010.01.07
更新 2010.01.07
更新 2010.01.07
VBScript で CSV の読み取り
概要
じゃんぬねっと氏作 CsvReader クラス を作りなおしました。
CSVフォーマット を文字コードの問題以外すべてサポートしています。
オリジナルとの主な違いは、以下の通り。
- ReadLine → 1レコードの文字列を返します。代わりにGetRow を使用してください。
- ReadToEnd メソッドを実装していません。全部読み込むメソッドが必要になるケースに遭遇しないので。
- フィールド内の改行は vbNewLine (CRLF) に変更されます。
- 最初のフィールドを読み込まない仕様を読み込むように変えています。
- ヘッダー フィールドよりもレコード フィールドが多くても動作します。
- ヘッダー フィールドの名前が重複していたら左側のフィールドのみアクセスできます。インデックスを直接指定したら両方アクセスできます。
CSVReader クラス
Option Explicit
' CsvReader クラス
Class CsvReader
' ストリーム
Private p_TextStream ' As TextStream
' ヘッダーの有無 - True だと最初のレコードをヘッダーとして扱う
Private p_HeaderExists ' As Boolean
' ヘッダー名と格納されているキーの関連付け
Private p_Header ' As Dictionary
' コンストラクタ
Private Sub Class_Initialize()
Set p_TextStream = Nothing
p_HeaderExists = False
Set p_Header = Nothing
End Sub
' デストラクタ
Private Sub Class_Terminate()
Call Close()
End Sub
' ヘッダーの有無を設定する
' 読み取り中の場合は効果なし
Public Property Let HeaderExists(ByVal exists) ' As Boolean
If p_TextStream Is Nothing Then
p_HeaderExists = exists
Set p_Header = Nothing
If exists Then Set p_Header = WScript.CreateObject("Scripting.Dictionary")
End If
End Property
' ヘッダーがあるなら True
Public Property Get HeaderExists() ' As Boolean
HeaderExists = p_HeaderExists
End Property
' ヘッダーを提供
' HeaderExists = False の場合は Nothing
Public Property Get Header() ' As Dictionary
If Me.HeaderExists Then
Set Header = p_Header
Else
Set Header = Nothing
End If
End Property
' 最終行だったら True
Public Property Get AtEndOfStream() ' As Boolean
If p_TextStream Is Nothing Then ' 無限ループ対策
AtEndOfStream = True
Else
AtEndOfStream = p_TextStream.AtEndOfStream
End If
End Property
' 指定されたファイルを開き p_TextSream に指定
' 開くことができたら True を返す
Public Function OpenFile(ByVal strFilePath) ' As Boolean
Dim FSO ' As FileSystemObject
Dim boolResult ' As Boolean
boolResult = False
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set p_TextStream = FSO.OpenTextFile(strFilePath)
If Err.Number = 0 Then
On Error Goto 0
' ヘッダーの取得
' 2つ目のファイルを開くときのためにヘッダーをクリアする
If Me.HeaderExists Then
Call p_Header.RemoveAll() ' p_Header クリア
Call SetHeaders()
End If
boolResult = True
Else
On Error Goto 0
End If
OpenFile = boolResult
End Function
' ストリームを閉じる
Public Sub Close()
If Not p_TextStream Is Nothing Then
On Error Resume Next
Call p_TextStream.Close()
On Error Goto 0
Set p_TextStream = Nothing
End If
End Sub
' 1レコードをフィールドごとに分割した配列で取得する
' フィールド内の改行コードはすべて CrLf に変換される
' 最終行は改行のみの可能性がある
Public Function ReadLineToArray()
Dim strRest ' As String
Dim fieldCount ' As Integer
Dim retArr() ' As String
Dim isEscape ' As Boolean
Dim intNext ' As Integer
If p_TextStream Is Nothing Then
ReadLineToArray = retArr
Exit Function
End If
strRest = p_TextStream.ReadLine()
fieldCount = -1
isEscape = False
Do While Len(strRest) > 0
' フィールドの1文字目を調べる
' Chr(34), Chr(44), それ以外の可能性がある
Select Case Left(strRest, 1)
Case Chr(34) ' " の場合
intNext = Instr(2, strRest, Chr(34), 0)
If intNext = 0 Then
strRest = strRest & vbNewLine & p_TextStream.ReadLine()
Else
If isEscape Then
retArr(fieldCount) = retArr(fieldCount) & Chr(34) _
& Mid(strRest, 2, intNext - 2)
Else
fieldCount = fieldCount + 1
ReDim Preserve retArr(fieldCount)
retArr(fieldCount) = Mid(strRest, 2, intNext - 2)
End If
strRest = Mid(strRest, intNext + 1)
isEscape = True
End If
Case Chr(44) ' , の場合
If isEscape Then ' 閉じダブルクォーテーションの直後だから
isEscape = False
Else
fieldCount = fieldCount + 1
ReDim Preserve retArr(fieldCount)
retArr(fieldCount) = vbNullString
End If
strRest = Mid(strRest, 2)
Case Else ' 通常の文字の場合
intNext = Instr(2, strRest, Chr(44), 0)
If isEscape Then
isEscape = False
If intNext = 0 Then ' 最終フィールド
retArr(fieldCount) = retArr(fieldCount) & Left(strRest, Len(strRest) - 1)
Exit Do
Else
retArr(fieldCount) = retArr(fieldCount) & Left(strRest, intNext - 1)
strRest = Mid(strRest, intNext + 1)
End If
Else
fieldCount = fieldCount + 1
ReDim Preserve retArr(fieldCount)
If intNext = 0 Then ' 最終フィールド
retArr(fieldCount) = strRest
Exit Do
Else
retArr(fieldCount) = Left(strRest, intNext - 1)
strRest = Mid(strRest, intNext + 1)
End If
End If
End Select
Loop
ReadLineToArray = retArr
End Function
' ヘッダーフィールドを p_Header に格納
' OpenFile メソッドからのみ呼び出す
Private Sub SetHeaders()
Dim strArr, intCount
strArr = ReadLineToArray()
For intCount = 0 To UBound(strArr)
' ヘッダー名が重複したら左側を優先する
' 右側を取得するにはインデックスで。
If Not p_Header.Exists(strArr(intCount)) Then
Call p_Header.Add(strArr(intCount), intCount)
End If
Next
End Sub
' 1レコードを Dictionary クラスとして受け取る
Public Function GetRow() ' As Dictionary
Dim strArr, intCount
Dim fRow ' As Directory
If Me.AtEndOfStream Then
Set GetRow = Nothing
Exit Function
End If
Set fRow = WScript.CreateObject("Scripting.Dictionary")
strArr = ReadLineToArray()
For intCount = 0 To UBound(strArr)
Call fRow.Add(intCount, strArr(intCount))
Next
Set GetRow = fRow
End Function
' 1レコードを文字列として読み取る。複数行あることに考慮
Public Function ReadLine() ' As String
If p_TextStream Is Nothing Then
ReadLine = Null
Exit Function
End If
' 現在のレコードが次の行に続く限り継続
' レコード内に改行がたくさんあるとパフォーマンスは低下する
' フィールド内の改行コードはすべて CrLf に変換される
Dim strLine
strLine = p_TextStream.ReadLine()
Do Until IsRecord(strLine)
strLine = strLine & vbNewLine & p_TextStream.ReadLine()
If Me.AtEndOfStream Then Exit Do
Loop
ReadLine = strLine
End Function
' 文字列がレコードとして完結していたら True
' クラス内では ReadLine メソッドからのみ呼び出す
Public Function IsRecord(ByVal strLine) ' As Boolean
If IsNull(strLine) Then
IsRecord = False
Exit Function
End If
Dim returnValue ' As Boolean
Dim strRest, intNext
returnValue = True
strRest = strLine
Do While Len(strRest) > 0
' フィールドの1文字目を調べる
' Chr(34), Chr(44), それ以外の可能性がある
Select Case Left(strRest, 1)
Case Chr(34) ' " の場合
intNext = Instr(2, strRest, Chr(34), 1)
If intNext = 0 Then
returnValue = False
Exit Do
Else
strRest = Mid(strRest, intNext + 1)
End If
Case Chr(44) ' , の場合(空文字列)
strRest = Mid(strRest, 2)
Case Else
intNext = Instr(2, strRest, Chr(44), 1)
If intNext = 0 Then
Exit Do
Else
strRest = Mid(strRest, intNext + 1)
End If
End Select
Loop
IsRecord = returnValue
End Function
' 表示するコードをいちいち書くのが面倒なので
Public Sub DebugPrintHeaders()
Dim k
WScript.Echo "DEBUG: " & String(20, "-")
WScript.Echo "p_Header.Count = " & p_Header.Count
For Each k In p_Header.Keys
WScript.Echo "p_Header.Item(" & k & ") = " & p_Header.Item(k)
Next
WScript.Echo "DEBUG: " & String(20, "-")
End Sub
End Class
使い方
インデックスで読み取ります。一番左が 0です。
Sub ReadByIndex()
Dim mycsv ' As CsvReader
Dim k, row, str
Set mycsv = New CsvReader
mycsv.HeaderExists = True
If mycsv.OpenFile("sample.txt") Then
Do Until mycsv.AtEndOfStream
Set row = mycsv.GetRow()
str = ""
For Each k In row
str = str & "(" & row(k) & ")"
Next
WScript.Echo "(" & str & ")"
Loop
Call mycsv.Close()
Else
WScript.Echo "ファイルが読み取れませんでした"
End If
End Sub
ヘッダー名で読み取ります。
Sub ReadByHeaderField()
Dim mycsv ' As CsvReader
Dim myheader ' As Dictionary
Dim k, row, str
Set mycsv = New CsvReader
mycsv.HeaderExists = True
If mycsv.OpenFile("sample.txt") Then
Set myheader = mycsv.Header
Do Until mycsv.AtEndOfStream
Set row = mycsv.GetRow()
str = ""
For Each k In myheader.Keys
str = str & "(" & row(myheader(k)) & ")"
Next
WScript.Echo "(" & str & ")"
Loop
Call mycsv.Close()
Else
WScript.Echo "ファイルが読み取れませんでした"
End If
End Sub
sample.txt は以下のようになっています。
"field_1","field_2","field_3" aaa,bbb,ccc 日本語1,abc1,日本語2 aaa,,ccc "aaa","bbb","ccc" zzz,yyy,xxx "aaa","bb b","ccc" "aaa","bb""b","ccc" aaa,bb"b,ccc "abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0 abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0 abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0","bbb","ccc" "aaa","bb""b","cc k c" aaa,bb"b,ccc aaa,bbb, "zzz ", "yyy " , " xxx " field_1,field_2,field_3 aaa,bbb aaa,bbb,ccc aaa,bbb,ccc,ddd aaa,"bbb",ccc "xxx",yyy,"zzz" "aaa","bb" "b","ccc"ReadByHeaderField の実行結果
((aaa)(bbb)(ccc)) ((日本語1)(abc1)(日本語2)) ((aaa)()(ccc)) ((aaa)(bbb)(ccc)) ((zzz)(yyy)(xxx)) ((aaa)(bb b)(ccc)) ((aaa)(bb"b)(ccc)) ((aaa)(bb"b)(ccc)) ((abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0 abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0 abcdefghi1abcdefghi2abcdefghi3abcdefghi4abcdefghi5abcdefghi6abcdefghi7abcdefghi8abcdefghi9abcdefghi0)(bbb)(ccc)) ((aaa)(bb"b)(cc k c)) ((aaa)(bb"b)(ccc)) ((aaa)(bbb)()) ((zzz )( "yyy " )( " xxx ")) ((field_1)(field_2)(field_3)) ((aaa)(bbb)()) ((aaa)(bbb)(ccc)) ((aaa)(bbb)(ccc)) ((aaa)(bbb)(ccc)) ((xxx)(yyy)(zzz)) ((aaa)(bb "b")(ccc))参考
タグ: VBScript