SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

VB テクニック編29 - CSV ファイル入出力 簡単版、汎用版、無敵版

■SAK 関数利用規程

  ・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
  ・著作権明示部分の改編は認めない。
  ・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
    プログラムを開発することは自由です。
  ・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
    その他有償プロダクトとして配布・販売するには、私の許可が必要です。
    (無償のフリーソフトウェアなら、自由に配布しても良い。)
  ・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
    賠償しません。

■CSV ファイル入出力 (簡単版)

  ・何項目かある CSV ファイルの特定列項目だけを編集出力するには、
    次のようにする。
    この例では、4 項目以上のデータがないと正常に動作しない。
    最後の line input は、改行まで無条件に読み飛ばすためのものである。

  dim fno as integer
  dim rec as string

  open "infile.csv" for input as #1 len = 32000
  open "outfile.csv" for output as #2 len = 32000
  do until eof(1)
    input #1, rec         '** 1 項目読み飛ばし
    input #1, rec         '** 2 項目リード
    print #2, rec & ",";  '** 2 項目ライト
    input #1, rec         '** 3 項目リード
    print #2, rec         '** 3 項目ライト
    line input #1, rec    '** 4 項目以降読み飛ばし
  loop
  close #2
  close #1

■CSV ファイル入出力 (汎用版)

  ・もう少し汎用的にレコード毎の項目数が固定なら、次のようにする。

  dim fno as integer
  dim ct as integer
  dim i as integer

  ct = GetCntCSV("infile.csv")
  if ct < 1 then
    msgbox "エラー"
    end
  end if
  redim rec(ct) as string
  open "infile.csv" for input as #1 len = 32000
  open "outfile.csv" for output as #2 len = 32000
  do until eof(1)
    for i = 1 to ct
      input #1, rec(i)
    next
    print #2, rec(2) & ",";  '** 2 項目ライト
    print #2, rec(3)         '** 3 項目ライト
  loop
  close #2
  close #1

■CSV ファイル入出力 (無敵版) (^^;

  ・データ個数が不揃いな特殊な形式の CSV など、凝ったハンドリングをする
    なら、次のようにする。
    Excel が作成する CSV などで、通常のファイル I/O で障害が出るときにも
    使用すると良い。
    指定パラメタは、次のとおり。
      IN_FILE  = 入力 CSV パスファイル名
      OUT_FILE = 出力 CSV パスファイル名
      ITEM_MAX = 予想最大項目数 - 1 (255 = 256 個までのデータバッファ)
    項目バッファ処理で、様々な処理を行う。項目データは、次のとおり。
      itemmax  = 該当レコード最大項目添字 (0 〜 項目数 - 1)
      item(0)       = 1 項目
      item(1)       = 2 項目
      item(itemmax) = 最終項目
    CSV 項目文字列取得関数 GetStrItem を修正すれば、様々な条件に対応可能。
    また、この関数は、全角のカンマを区切り記号として誤動作することもない。
    標準 I/O は、いつの版数からか、全角カンマを半角カンマと同じに区切り
    と認識してしまうので、実に具合の悪い場合がある。
    (インポート、エクスポート、コンバート、CSV ファイルオープン)

  const IN_FILE  = "infile.csv"
  const OUT_FILE = "outfile.csv"
  const ITEM_MAX = 255
  const STR_INIT = false
  const STR_NEXT = true
  dim fno as long
  dim fno2 as long
  dim rec as string
  dim s as string
  dim item(ITEM_MAX) as string
  dim itemmax as long
  dim i as long

'** ファイルオープン
  fno = freefile
  open IN_FILE for input as fno len = 32000
  fno2 = freefile
  open OUT_FILE for output as fno2 len = 32000

'** レコードループ開始
  do until eof(fno)

    '** 1 レコードリード
    line input #fno, rec
    itemmax = -1
    s = GetStrItem(rec, STR_INIT)
    do until s = chr(0)
      itemmax = itemmax + 1
      if itemmax > ITEM_MAX then
        close fno
        msgbox "項目バッファオーバー"
        end
      end if
      item(itemmax) = s
      s = GetStrItem(rec, STR_NEXT)
    loop

    '** 項目バッファ処理
    print #fno2, chr(&H22) & item(1) & chr(&H22) & ",";  '** 2 項目ライト
    print #fno2, chr(&H22) & item(2) & chr(&H22)         '** 3 項目ライト

'** レコードループ終了
  loop

'** ファイルクローズ
  close fno2
  close fno

'=======================================================================
'  CSV 項目文字列取得
'=======================================================================
public function GetStrItem(rec as string, init as boolean) as string

  const STR_INIT = false
  const STR_NEXT = true
  static start as long
  static rln as long
  dim str as long

'** 初期化
  if init <> STR_NEXT then
    start = 1
    rln = len(rec)
  end if

'** 左辺空白スキップ
  for start = start to rln
    if mid(rec, start, 1) <> " " then exit for
  next

'** データ項目なし
  if start > rln + 1 then
    GetStrItem = chr(0)
    exit function
  end if

'** 空項目
  if start > rln then
    start = start + 1
    GetStrItem = ""
    exit function
  end if
  if mid(rec, start, 1) = "," then
    start = start + 1
    GetStrItem = ""
    exit function
  end if

'** 引用句 ( chr(&H22) = 『"』)
  if mid(rec, start, 1) = chr(&H22) then
    start = start + 1
    str = start
    for start = start to rln
      if mid(rec, start, 1) = chr(&H22) then exit for
    next
    if start > rln then
      GetStrItem = mid(rec, str)
    else
      GetStrItem = mid(rec, str, start - str)
      start = start + 1
      for start = start to rln
        if mid(rec, start, 1) = "," then exit for
      next
    end if
    start = start + 1
    exit function
  end if

'** データ項目
  str = start
  for start = start to rln
    if mid(rec, start, 1) = "," then exit for
  next
  if start > rln then
    GetStrItem = rtrim(mid(rec, str))
  else
    GetStrItem = rtrim(mid(rec, str, start - str))
  end if
  start = start + 1

end function

■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK