[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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

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

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 & """"

' 差分チェックして非マッチレコードだけ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

' 判定カラムの値が全部同じレコードが見つかった場合はループを抜ける

If MtchFlg Then Exit For

' 最後まで判定カラムの値が全部同じレコードがない場合だけ出力用に追加

If MtchFlg = False Then

lnVal = ""

For Each k In DicSrcCSV.Keys()

If Len(lnVal) > 0 Then lnVal = lnVal & ","

lnVal = lnVal & """" & DicSrcCSV(k)(r) & """"

' 全項目が空白になってしまう行は捨てる。

If Len(Replace(Replace(lnVal, """", ""),",","")) > 0 Then

OutPutStr = OutPutStr & vbCrLf & lnVal

End If

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

tmpDic.Add ColName, AryVal

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

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

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

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

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

[WinActor]CSVの差分抽出

１．ＣＳＶ差分抽出

２．実行イメージ