[WinActor]CSVの差分抽出

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にしていするとする。

３番のいちごさん消して、４番のトマトさんの単価が変わりました。

ホンで、判定カラムに「商品名,単価」って指定するとこうなる訳だ。

ホンで、ホンで、判定カラムの指定が「商品名」だけだと、こうなる訳だ。

判定カラムに含めた項目が変更されていた場合は、同一レコードなしって判断されて差分レコードとして出力されるし、レコードが削除されてた場合も同一レコードなしで出てくるってことです。