対象のCSVファイルの1行目はフィールド名になっている必要があります。
ADODBで実装していて絞り込み条件はSQL言語のWhereなどで指定できます。
64bit版OSで実行する場合は注意が必要です。
- srcCSV: 絞り込むCSVファイル
- dstCSV: 結果出力先CSVファイル
- condition: SQL言語の条件部分 e.g) Where フィールド名='値'
Function extractCSV( srcCSV, dstCSV, condition )
Dim objFSO
Dim objFileSrc
Dim objFileDst
Dim objCnn 'ADODB Connection
Dim objRS 'ADODB ResultSet
Dim strDrv 'ドライバ指定
Dim strDBQ 'CSVファイルのフォルダ指定
Dim strROOption 'モード設定(1:ReadOnly 0:Read/Write)
Dim strQuerySelect '絞り込み用SQLステートメント
Dim strField
Dim strInsVal
strDrv = "Driver={Microsoft Text Driver (*.txt; *.csv)};"
strDBQ = "DBQ=" & getFileDir( srcCSV ) & ";"
strROOption = "ReadOnly=1"
strQuerySelect = "select * from " & getFileName( srcCSV ) & " " & condition
'フィールド名コピー
set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
call createDir( getFileDir( dstCSV ) )
set objFileSrc = objFSO.OpenTextFile( srcCSV, 1, True )
set objFileDst = objFSO.OpenTextFile( dstCSV, 2, True )
call objFileDst.WriteLine( objFileSrc.ReadLine )
objFileSrc.Close
'絞り込み結果取得
set objCnn = CreateObject( "ADODB.Connection" )
objCnn.Open strDrv & strDBQ & strROOption
set objRS = objCnn.Execute( strQuerySelect )
Do until objRS.EOF
'結果をCSVに出力
strInsVal = ""
for each strField in objRS.Fields
strInsVal = strInsVal & "'" & strField & "',"
next
strInsVal = Left( strInsVal, Len( strInsVal ) - 1 )
objFileDst.WriteLine( strInsVal )
objRS.MoveNext
Loop
'終了処理
objFileDst.Close
objRS.Close
objCnn.Close
set objFileDst = Nothing
set objFileSrc = Nothing
set objFSO = Nothing
set objRS = Nothing
set objCnn = Nothing
end Function
