CSV系はもうね、それただのvbスクリプトでしょって話なんだけどもね。
GUI操作とか関係なく、なんか、もちろんやれるよね？的な雰囲気ですよ。
たとえば、
「毎日、特定ステータスのレコードをCSVでダンプ出力してるんだけど、
そのままWinActorでデータ連携しようとすると、変更のないデータも更新しようとして無駄だから
前日のCSVから差分抽出して更新対象だけ連携してほしいなー。」
とかね。
はい、という訳でスクリプト実行でCSVの差分抽出できる様にしてみましたよー。
１．ＣＳＶ差分抽出
INPUTには、親CSVと間引くCSVを指定してキーにする判定カラムを指定（カンマ区切りで複数選択可）して出力ファイル名を指定するだけ。
いつもの如く、スクリプト実行ステージのスクリプトタブに張り付ければすぐに使えるスクリプトです。
Dim DicSrcCSV, SrcTxt
Dim DicMtchCSV, MtchTxt
Dim KeyCols
Dim OutPutFile, ErrMsg, OutPutStr
' 親CSVの辞書化
SrcTxt = Read_TEXT(!親ファイル名!)
Set DicSrcCSV = CSV_to_Dic(SrcTxt)
' 間引くCSVの辞書化
MtchTxt = Read_TEXT(!間引くファイル名!)
Set DicMtchCSV = CSV_to_Dic(MtchTxt)
KeyCols = split(Replace(!判定カラム(カンマ区切り)!, """", ""), ",")
OutPutFile = !出力ファイル名!
' カラムチェック
ErrMsg = ""
For i=0 To UBound(KeyCols)
If Not (DicSrcCSV.Exists(KeyCols(i)) And DicMtchCSV.Exists(KeyCols(i))) Then
If Len(ErrMsg) > 0 Then ErrMsg = ErrMsg & "、"
ErrMsg = ErrMsg & KeyCols(i)
End If
Next
If Len(ErrMsg) > 0 Then
Err.Raise 501, "", "CSVの判定カラムが見つかりません。「" & ErrMsg & "」"
WScript.Quit
End If
OutPutStr = ""
' ヘッダ行の生成
For Each k In DicSrcCSV.Keys()
If Len(OutPutStr) > 0 Then OutPutStr = OutPutStr & ","
OutPutStr = OutPutStr & """" & k & """"
Next
' 差分チェックして非マッチレコードだけCSVに成型
Dim r, s, t, MtchFlg
For r=0 To UBound(DicSrcCSV(KeyCols(0)))
For s=0 To UBound(DicMtchCSV(KeyCols(0)))
MtchFlg = True
For t=0 To UBound(KeyCols)
If DicSrcCSV(KeyCols(t))(r) <> DicMtchCSV(KeyCols(t))(s) Then MtchFlg = False
Next
' 判定カラムの値が全部同じレコードが見つかった場合はループを抜ける
If MtchFlg Then Exit For
Next
' 最後まで判定カラムの値が全部同じレコードがない場合だけ出力用に追加
If MtchFlg = False Then
lnVal = ""
For Each k In DicSrcCSV.Keys()
If Len(lnVal) > 0 Then lnVal = lnVal & ","
lnVal = lnVal & """" & DicSrcCSV(k)(r) & """"
Next
' 全項目が空白になってしまう行は捨てる。
If Len(Replace(Replace(lnVal, """", ""),",","")) > 0 Then
OutPutStr = OutPutStr & vbCrLf & lnVal
End If
End If
Next
Write_TEXT OutPutStr, OutPutFile
'■ メイン処理ここまで ■ 以下、呼び出し関数 ■
Function Read_TEXT(FilePath)
Dim objFS, objTXT, Rslt
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FileExists(FilePath) Then
Set objTXT = objFS.OpenTextFile(FilePath, 1)
Rslt = objTXT.ReadAll()
objTXT.close
Set objTXT = Nothing
Else
Rslt = ""
End If
Set objFS = Nothing
Read_TEXT = Rslt
End Function
Function Write_TEXT(ContentStr, FilePath)
Dim objFS, objTXT
On Error Resume Next
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTXT = objFS.OpenTextFile(FilePath, 2, True)
objTXT.Write ContentStr
objTXT.close
Set objTXT = Nothing
Set objFS = Nothing
If Err.Number > 0 Then
Write_TEXT = False
Err.Clear
Else
Write_TEXT = True
End If
End Function
Function CSV_to_Dic(SrcTxtStr)
Dim lnTXT, tmpDic, RowBnd, ColHeader
Dim AryVal(), RowCols
Set tmpDic = WScript.CreateObject("Scripting.Dictionary")
lnTXT = split(SrcTxtStr, vbCrLf)
RowBnd = UBound(lnTXT)
ColHeader = splitEx(lnTXT(0), NULL, NULL, NULL)
For i=0 To UBound(ColHeader)
ColName = ColHeader(i)
Erase AryVal
ReDim AryVal(RowBnd)
For j=1 To RowBnd
RowCols = splitEx(lnTXT(j), NULL, NULL, NULL)
If UBound(ColHeader) <= UBound(RowCols) Then
AryVal(j-1) = RowCols(i)
End If
Next
tmpDic.Add ColName, AryVal
Next
Set CSV_to_Dic = tmpDic
End Function
' 引用: http://blog.livedoor.jp/tea_cocoa_cake/archives/5356742.html
'! Split()のテキスト区切り対応版
'! テキスト区切り文字(例CSVの")に対応した区切りを行う
'! @param source 元文字列
'! @param colDelim 列区切り文字(NULL可、NULLの場合「,」使用)
'! @param lineDelim 行区切り文字(NULL可、NULLの場合vbCrLfを使用)
'! @param textDelim テキスト区切り文字(NULL可、NULLの場合「"」を使用) (textDelim2つでテキスト区切り文字エスケープ)
'! @return 1次元配列 (改行がある場合は配列要素としてvbNullChar単体が格納される
public function splitEx(source, colDelim, lineDelim, textDelim)
splitEx = NULL
dim textMode: textMode = False
if (isNull(colDelim) ) Then
colDelim = ","
end if
if (isNull(lineDelim) ) Then
lineDelim = vbCrLf
end if
if (isNull(textDelim) ) Then
textDelim = """"
end if
dim ab : set ab = New ArrayBuilder
dim textBuf : textBuf = "" ' テキストバッファ
dim char_i : char_i = 1 ' 文字列のインデックス
Do while (char_i <= len(source))
dim curChar : curChar = getChar(source, char_i)
if(textMode = True) Then
select case curChar
case textDelim
'! 1文字先読み And エスケープ判定
if ( getChar(source, char_i + 1) = textDelim ) Then
' エスケープ
textBuf = textBuf & getChar(source, char_i + 1)
char_i = char_i + 1 ' 先読み分カウンタを加算
else
' テキストモードOFF
textMode = False
end if
case Else
textBuf = textBuf & curChar
end select
else
select case curChar
case colDelim
ab.add textBuf
textBuf = ""
case lineDelim
ab.add textBuf
ab.add vbNullChar ' 改行を示す
textBuf = ""
case vbCr
'! 1文字先読み And lineDelim=vbCrLf(※2文字)の場合の特殊な判定
if ( getChar(source, char_i + 1) = vbLf And lineDelim = vbCrLf ) Then
ab.add textBuf
ab.add vbNullChar ' 改行を示す
textBuf = ""
char_i = char_i + 1 ' 先読み分カウンタを加算
else
textBuf = textBuf & curChar
end if
case textDelim
' テキストモードON
textMode = True
case Else
textBuf = textBuf & curChar
end select
end if
char_i = char_i + 1
loop
' 最後にテキストバッファの残りを処理
ab.add textBuf
splitEx = ab.toArray()
end function
'! 文字列から1文字取得。文字列終端(VBScripでは通常参照しない)の場合ではvbNullChar(00)を返す
'! @param source 元文字列
'! @param index 文字列のインデックス
'! @return 文字
private function getChar(source, index)
getChar = ""
if (index <= 0 Or index > (len(source) + 1) ) Then
err.raise 1025,,"範囲外の参照"
exit function
end if
' 文字列終端の場合
if (index = (len(source) + 1) ) Then
getChar = vbNullChar
end if
getChar = mid(source, index, 1)
end function
'! 配列生成
class ArrayBuilder
private my_lastIndex
private my_array()
Public Sub Class_Initialize
dim INITIAL_SIZE : INITIAL_SIZE = 8
my_lastIndex = -1
redim Preserve my_array(INITIAL_SIZE - 1) ' 注意...配列は(指定サイズ + 1)のサイズで領域が確保される
End Sub
Public Sub Class_Terminate
End Sub
'! 値の参照
'! @param index 配列インデックス
'! @return 値
public property get item(index)
if (index < 0 Or index > my_lastIndex) Then
err.raise 1025,,"範囲外の参照"
exit property
end if
item = my_array(index)
end property
'! 値のセット
'! @param index 配列インデックス
'! @param value 値
public property let item(index, value)
if (index < 0) Then
err.raise 1025,,"範囲外の参照"
exit property
end if
' Expand
Do While (index >= getSize() )
call expand()
Loop
if (index > my_lastIndex) Then
my_lastIndex = index
end if
my_array(index) = value
end property
'! 最後尾に値の追加
'! @param value 値
public sub add(value)
me.item(my_lastIndex + 1) = value
end sub
'! 配列拡張
private sub expand()
'+ wscript.echo "#Expanded!"
' 再確保のオーバヘッド軽減のため大きめにサイズを拡張
redim Preserve my_array(getSize() * 2 - 1)
end sub
'! 配列サイズ取得
'! @return 現在の配列サイズ
private function getSize()
'+ wscript.echo "#size:" & UBound(my_array) - LBound(my_array) + 1
getSize = UBound(my_array) - LBound(my_array) + 1
end function
'! 要素に合わせて配列サイズを縮小
'! @param arr 配列
'! @return 縮小後の配列
private function fit(ByRef arr)
redim Preserve arr(my_lastIndex)
fit = arr
end function
'! 配列を返す
'! @return 配列
public function toArray()
dim tmpArray : tmpArray = my_array
tmpArray = fit(tmpArray)
toArray = tmpArray
end function
end class
２．実行イメージ
たとえば、こんなリストを親にして
で、こんなリストを間引くCSVにしていするとする。
３番のいちごさん消して、４番のトマトさんの単価が変わりました。
ホンで、判定カラムに「商品名,単価」って指定するとこうなる訳だ。
ホンで、ホンで、判定カラムの指定が「商品名」だけだと、こうなる訳だ。
判定カラムに含めた項目が変更されていた場合は、同一レコードなしって判断されて差分レコードとして出力されるし、レコードが削除されてた場合も同一レコードなしで出てくるってことです。