作成 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 Subsample.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