タグ
  Active Directory (51)
  ANSI (1)
  bash (1)
  BAT (14)
  bind (1)
  CentOS (3)
  CSharp (1)
  C言語 (4)
  DNS (3)
  Excel (1)
  Fedora (4)
  FreeBSD (3)
  iSCSI (1)
  Java (11)
  JavaScript (6)
  Link (4)
  Linux (15)
  Mail (1)
  Microsoft (4)
  NIS (1)
  OpenLDAP (2)
  OpenSolaris (4)
  PHP (2)
  PostgreSQL (2)
  PowerShell (33)
  RFC (3)
  Solaris (10)
  SQL Server (1)
  Ubuntu (3)
  VBScript (65)
  Visual Basic (1)
  VMware (2)
  Windows (14)
  WMI (16)
  WSF (5)
  WSH (10)
  作成中 (5)
  慣用句 (1)
  正規表現 (6)
VBScript で CSV の読み取り
目次
概要
CSVReader クラス
使い方
概要

じゃんぬねっと氏作 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))
参考

CSVフォーマット | VBScript - CSV ファイルを読み込む CsvReader クラス

タグ: VBScript
[リロード] [記事修正] [新規作成] [使用方法]
©2004-2010 UPKEN