VBSのほうが処理がはやい。
関数プログラミングだったらRust使った方がいいと思われ
参考
https://qiita.com/yaju/items/75e39c774bd122190cd2
VBA
Option Explicit
'定数
Const writeMessage As String = "文字変換結果リストにエラーはありませんでした"
Const succesedMessage As String = "正常に処理が完了しました"
Const errorMessage_ws As String = "対象のCSVファイルが存在しません。 ファイル名："
Const errorMessage_fd As String = "ファイルダイアログがキャンセルされました"
Const errLogFolder As String = "取込用のCSVファイルが０件です。 パス："
Const LogErrFileName As String = "\LOG\FTRAN_Err.log"
Const ErrListFileName As String = "\OUT\FTRAN_Err.csv"
Const ErrListFileNameT As String = "\OUT\FTRAN_Err対象文字一覧.csv"
Const convertedCsvPath As String = "\CSV_B\"
'Const targetError As String = "〓"
Sub ボタン1_Click()
'オブジェクト
Dim fso As FileSystemObject
Dim fd As Object
Dim reg As Object
Dim file As Object
'リソース
Dim relativePath As String
Dim errLogFile As String
Dim folderPath As String
Dim filepathErrList As String
Dim filepathErrListT As String
Dim filepath() As String
Dim filepath_target() As String
'交換結果ファイル（エラー）配列
Dim errCodesT() As String
Dim writedata() As String
'ループ／判定チェック用変数
Dim i As Long
Dim j As Long
Dim substring As String
Dim substrings() As String
Dim csvfile As String
'その他変数
Dim icount As Long
'相対パス
relativePath = ActiveWorkbook.path
'FTRAN文字交換実行結果（エラー）ログパス
errLogFile = relativePath & LogErrFileName
'FTRAN文字交換後CSVデータログ
folderPath = relativePath & convertedCsvPath
'FTRAN文字交換エラーリスト（CSV）
filepathErrList = relativePath & ErrListFileName
'FTRAN文字交換元エラーリスト（CSV）
filepathErrListT = relativePath & ErrListFileNameT
'ファイルオブジェクトをセットする
Set fso = New Scripting.FileSystemObject
'交換結果ファイル（エラー）存在チェック
If Not fso.FileExists(errLogFile) Then
MsgBox errLogFile & "が存在しません", vbExclamation
Exit Sub
End If
'変換後csvファイルの一覧を取得
For Each file In fso.GetFolder(folderPath).files
If fso.GetExtensionName(file.path) = "csv" Then: _
Call addToArrayStrings(filepath, file.path)
Next file
' 変換後csvファイルの一覧を取得(サブフォルダー)
Call getAllFiles(folderPath, fso, filepath)
' エラーリスト作成結果をicountにセットする
icount = createErrLogFile(errLogFile, fso, writedata)
' エラーリストが存在しない場合
If icount = 0 Then
MsgBox writeMessage, vbExclamation
Exit Sub
End If
'FTRAN_Err.listを作成する
Call writeOutputCSV(filepathErrList, fso, writedata)
' csvファイル一覧存在チェック
If isEmptyArrayString(filepath) Then
MsgBox errLogFolder & folderPath, vbExclamation
Exit Sub
End If
' 読込CSVファイルリストを作成する。
Call readCSVFileCreate(filepath, writedata, filepath_target)
' 変換後csv対象行エラー名称抽出
For i = 0 To UBound(writedata)
'文字列をタブ区切りで取得する
substrings = Split(writedata(i), vbTab)
' 読込CSVファイルリストから対象の業務ファイルを選択する。
For j = 0 To UBound(filepath_target)
'CSVファイルを選択
csvfile = filepath_target(j)
'CSVファイルが対象業務の場合
If InStr(csvfile, substrings(0)) Then
Call SerachErrorData(substrings, fso, csvfile, errCodesT)
End If
Next j
Next i
'gset(エラー変換結果データ）を出力する。
If isEmptyArrayString(errCodesT) = False Then
Call writeOutputCSV(filepathErrListT, fso, errCodesT)
End If
End Sub
'##################################################
'## 配列に要素を追加する関数
'##
'## 引数１：一次元配列
'## 引数２：配列格納データ
'##
'##################################################
Sub addToArrayStrings(ByRef s() As String, ByVal v As String)
If isEmptyArrayString(s) Then
ReDim s(0)
s(0) = v
Else
ReDim Preserve s(UBound(s) + 1)
s(UBound(s)) = v
End If
End Sub
'##################################################
'## 配列Nullチェック関数
'## addToArrayStrings()のNULLチェック用
'##
'## 引数１：一次元配列
'##
'##################################################
Function isEmptyArrayString(s() As String) As Boolean
If (Not s) = -1 Then
isEmptyArrayString = True
Else
isEmptyArrayString = (UBound(s) = 0 And s(0) = "")
End If
End Function
'##################################################
'## サブフォルダーのCSVファイル検索
'##
'## 引数１： サブディレクトリ―パス
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： 文字コード変換元CSVファイル一覧
'##
'##################################################
Sub getAllFiles(ByVal path As String, ByRef fso As FileSystemObject, ByRef filepath() As String)
Dim files As Object
Dim fol As Object
Dim folders As Object
Dim file As Object
Set folders = fso.GetFolder(path).SubFolders
If IsObject(folders) Then
For Each fol In folders
Set files = fso.GetFolder(fol).files
If IsObject(files) Then
For Each file In files
If fso.GetExtensionName(file.path) = "csv" Then
Call addToArrayStrings(filepath, file.path)
End If
Next file
End If
'サブフォルダーがあれば繰り返し探索する
Call getAllFiles(fol, fso, filepath)
Set files = Nothing
Next fol
End If
End Sub
'##################################################
'## エラーログリストを出力する関数
'##
'## 引数１： CSVファイルパス
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： 出力リスト
'##
'##################################################
Function createErrLogFile(ByVal fileName As String, ByRef fso As FileSystemObject, ByRef outputList() As String) As Integer
'## 実行フラグ
Dim notxFlag As Boolean
'## CSVデータ取得文字列
Dim substring As String
'## CSVデータ取得文字列区切り
Dim substrings() As String
'## CSVデータ取得文字列区切り
Dim substrings_w() As String
'## 文字変換エラー文字
Dim errorCode As String
'## CSVデータ読み込み回数
Dim icount As Long
'## 結合文字列
Dim concatData As String
'## ループ処理用変 i
Dim i As Long
'|| ファイルオブジェクト
Dim file As Object
'icountを初期化
icount = 0
'文字交換エラーリスト(CSVファイル)をオブジェクト定義する
Set file = fso.OpenTextFile(fileName)
'文字交換エラーリストを開いて、ログ(１行目～）の中身を出力する
Do While file.AtEndOfStream = False
'取得した文字列をsubstringに格納する
substring = file.ReadLine
' エラー対象の文字コードの場合
If InStr(substring, "CD:") > 0 Then
'実行フラグをオン
notxFlag = True
'文字列をカンマ区切りで取得する
substrings = Split(substring, ",")
'配列errCodesに１件も要素が格納されていない場合
If isEmptyArrayString(outputList) = False Then
'エラー文字を格納する
errorCode = Replace(substrings(4), """", "")
'未定義拡張漢字以外のエラー文字の場合
'If Not InStr(errorCode, targetError) Then
'エラー内容に同じエラー内容が存在するかチェック
For i = 0 To UBound(outputList)
substrings_w = Split(outputList(i), vbTab)
'同じエラーが既に登録されている場合
If StrComp(substrings_w(4), errorCode) = 0 Then
'実行フラグをFLASE(実行しない)にして、ループから外れる
notxFlag = False
Exit For
End If
Next i
'End If
End If
'実行フラグがTRUE(実行する)場合、配列へ各要素を格納する。
If (notxFlag) Then
'結合文字列に対象の項目データを結合した値をセットする。
concatData = substrings(0) & vbTab & substrings(1) & vbTab & substrings(2) & vbTab & substrings(3) & vbTab & Replace(substrings(4), """", "")
'結合文字列をリストに格納する。
Call addToArrayStrings(outputList, concatData)
'処理件数カウント
icount = icount + 1
End If
End If
Loop
' csvファイルを閉じてメモリを解放する。
file.Close
Set file = Nothing
createErrLogFile = icount
End Function
'##################################################
'## CSVにデータを書き込みする関数
'##
'## 引数１： CSVファイルパス(書き込み先）
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： データリスト
'##
'##################################################
Sub writeOutputCSV(writeFileName As String, ByRef fso As FileSystemObject, list() As String)
'## CSVファイル(書込)
Dim f As Object
'## ループ処理用変数i
Dim i As Long
' CSVファイル（書込）が存在しない場合
If fso.FileExists(writeFileName) = False Then
'|| CSVファイルを作成したファイルオブジェクトを定義する。
Set f = fso.CreateTextFile(writeFileName, False)
Else
'|| ファイルオブジェクトを定義する（書込モード）
Set f = fso.OpenTextFile(writeFileName, ForWriting)
End If
'リストのデータをファイル(CSV)へ出力する
For i = 0 To UBound(list)
f.WriteLine list(i)
Next i
' csvファイルを閉じてメモリを解放する。
f.Close
Set f = Nothing
End Sub
'#################################################
'## 文字コード変換元のCSVファイル読込リスト作成
'##
'## 引数１：文字コード変換元CSVファイル一覧
'## 引数２：エラーログリスト
'## 引数３：CSVファイル読込リスト
'##
'#################################################
Sub readCSVFileCreate(filepath() As String, writedata() As String, ByRef filepath_target() As String)
'## ループ処理用変 i
Dim i As Long
'## ループ処理変数 j
Dim j As Long
'## CSVファイル名
Dim csvfile As String
'## 文字区切り変換リスト
Dim substrings() As String
' 読込CSVファイルを対象業務のみ抽出する。
For i = 0 To UBound(filepath)
'csvファイルのパス
csvfile = filepath(i)
'読込CSVファイルリストに同じCSVパスが存在するかチェック
For j = 0 To UBound(writedata)
'文字列をタブ区切りで取得する
substrings = Split(writedata(j), vbTab)
'状態が対象のCSVファイルである場合
If InStr(csvfile, substrings(0)) > 0 Then
'読込CSVファイルリストへ追加する
Call addToArrayStrings(filepath_target, csvfile)
'ループ処理から抜ける
Debug.Print filepath(i)
Exit For
End If
Next j
Next i
End Sub
'#################################################
'## エラーデータ検索関数
'##
'## 引数１：エラーログリスト
'## 引数２：FSO(ファイルシステムオブジェクト)
'## 引数３：CSVファイル
'## 引数４：エラーデータリスト
'##
'#################################################
Sub SerachErrorData(writedata_substrings() As String, ByRef fso As FileSystemObject, csvfile As String, ByRef errCodesT() As String)
'## ループ処理用変 i
Dim i As Long
'## CSVファイルの最大行
Dim csvmaxrow As Long
'## 検索対象行
Dim mpCSVFilebgnRow As Long
'## 検索対象列
Dim mpCSVFilesetCol As Long
'## 検索対象列インデックス
'Dim mpCSVFileColIndex As Long
'## エラー変換結果データ
Dim gset As String
'## readlineデータ
Dim substring As String
'## readlineデータ（タブ区切り）
Dim substrings() As String
'|| ファイルオブジェクト
Dim file As Object
'CSVファイルの行数を取得する。
csvmaxrow = fso.OpenTextFile(fileName:=csvfile, IOMode:=8).line
'エラー文字対象行をセット(0行目から始まるため-１)
mpCSVFilebgnRow = Val(writedata_substrings(2))
'エラー文字対象列をセット(0列目から始まるため-１)
mpCSVFilesetCol = Val(writedata_substrings(3))
'CSVファイルをオブジェクト定義する
Set file = fso.OpenTextFile(csvfile)
With file
'csvの最大行数が対象の文字コード行数より小さい場合
If csvmaxrow < mpCSVFilebgnRow Then
'ファイルを閉じる
.Close
'処理を終了する。
Exit Sub
End If
'取り込むCSVファイルの開始行の値だけ処理を繰り返す
For i = 1 To mpCSVFilebgnRow - 1
'最大行の場合、ループから抜ける
If i >= csvmaxrow Or .AtEndOfStream Then
Exit For
End If
'行参照位置を1つスキップする
.SkipLine
Next i
' Debug.Print "今のLine" & .line & "対象行" & mpCSVFilebgnRow
'EOF判定(ファイル末端）の場合、 処理を終了する。
If .AtEndOfStream Then
'ファイルを閉じる
.Close
'処理を終了する。
Exit Sub
End If
'指定行目の文字列を読み込む
substring = .ReadLine
'文字列をタブ区切りで取得する
substrings = Split(substring, vbTab)
'検索文字数の位置がCSVの最大文字数より大きい場合
If mpCSVFilesetCol > Len(substring) Then
'ファイルを閉じる
.Close
'処理を終了する。
Exit Sub
End If
'文字化けしているエラー文字列を抽出する
For i = 0 To UBound(substrings)
'エラー文字列の場合
If InStr(substrings(i), writedata_substrings(4)) > 0 Then
'エラー変換結果データを文字列に結合する。
gset = writedata_substrings(0) & vbTab & writedata_substrings(1) & vbTab & Replace(substrings(i), """", "") & vbTab & "エラー対象文字＝" & writedata_substrings(4)
'エラー文字(真)を格納
Call addToArrayStrings(errCodesT, gset)
'検索文字列がヒットしたらループから抜ける
Exit For
End If
Next i
End With
'csvファイルを閉じる
file.Close
Set file = Nothing
End Sub
VBS用
Option Explicit
'定数
Const writeMessage = "文字変換結果リストにエラーはありませんでした"
Const succesedMessage = "正常に処理が完了しました"
Const errorMessage_ws = "対象のCSVファイルが存在しません。 ファイル名："
Const errorMessage_fd = "ファイルダイアログがキャンセルされました"
Const errLogFolder = "取込用のCSVファイルが０件です。 パス："
Const LogErrFileName = "\LOG\FTRAN_Err.log"
Const ErrListFileName = "\OUT\FTRAN_Err.csv"
Const ErrListFileNameT = "\OUT\FTRAN_Err対象文字一覧.csv"
Const convertedCsvPath = "\CSV_B\"
Main()
Sub Main()
'オブジェクト
Dim fso
Dim fd
Dim reg
Dim file
'リソース
Dim relativePath
Dim errLogFile
Dim folderPath
Dim filepathErrList
Dim filepathErrListT
Dim filepath()
Dim filepath_target()
'交換結果ファイル（エラー）配列
Dim errCodesT()
Dim writedata()
'ループ／判定チェック用変数
Dim i
Dim j
Dim substring
Dim substrings
Dim csvfile
'その他変数
Dim icount
'ファイルオブジェクトをセットする
Set fso = CreateObject("Scripting.FileSystemObject")
'カレントディレクトリーパス
relativePath = fso.GetAbsolutePathName(".")
'FTRAN文字交換実行結果（エラー）ログパス
errLogFile = relativePath & LogErrFileName
'FTRAN文字交換後CSVデータログ
folderPath = relativePath & convertedCsvPath
'FTRAN文字交換エラーリスト（CSV）
filepathErrList = relativePath & ErrListFileName
'FTRAN文字交換元エラーリスト（CSV）
filepathErrListT = relativePath & ErrListFileNameT
'交換結果ファイル（エラー）存在チェック
If Not fso.FileExists(errLogFile) Then
MsgBox errLogFile & "が存在しません", vbExclamation
Exit Sub
End If
'変換後csvファイルの一覧を取得
For Each file In fso.GetFolder(folderPath).files
If fso.GetExtensionName(file.path) = "csv" Then: _
Call addToArrayStrings(filepath, file.path)
Next
' 変換後csvファイルの一覧を取得(サブフォルダー)
Call getAllFiles(folderPath, fso, filepath)
' エラーリスト作成結果をicountにセットする
icount = createErrLogFile(errLogFile, fso, writedata)
' エラーリストが存在しない場合
If icount = 0 Then
MsgBox writeMessage, vbExclamation
Exit Sub
End If
'FTRAN_Err.listを作成する
Call writeOutputCSV(filepathErrList, fso, writedata)
' 読込CSVファイルリストを作成する。
Call readCSVFileCreate(filepath, writedata, filepath_target)
' 変換後csv対象行エラー名称抽出
For i = 0 To UBound(writedata)
'文字列をタブ区切りで取得する
substrings = Split(writedata(i), vbTab)
' 読込CSVファイルリストから対象の業務ファイルを選択する。
For j = 0 To UBound(filepath_target)
'CSVファイルを選択
csvfile = filepath_target(j)
'CSVファイルが対象業務の場合
If InStr(csvfile, substrings(0)) > 0 Then
Call SerachErrorData(substrings, fso, csvfile, errCodesT)
End If
Next
Next
'gset(エラー変換結果データ）を出力する。
If isEmptyArrayString(errCodesT) =True Then
Call writeOutputCSV(filepathErrListT, fso, errCodesT)
End If
End Sub
'##################################################
'## 配列に要素を追加する関数
'##
'## 引数１：一次元配列
'## 引数２：配列格納データ
'##
'##################################################
Sub addToArrayStrings(ByRef s, ByVal v)
If isEmptyArrayString(s) = False Then
ReDim s(0)
s(0) = v
Else
ReDim Preserve s(UBound(s) + 1)
s(UBound(s)) = v
End If
End Sub
'##################################################
'## 配列Nullチェック関数
'## addToArrayStrings()のNULLチェック用
'##
'## 引数１：一次元配列
'##
'##################################################
Function isEmptyArrayString(arrParam)
Dim lintUBound : lintUBound = 0
Dim llngError : llngError = 0
isEmptyArrayString = False
If Not IsArray(arrParam) Then : Exit Function
'' Test the bounds
On Error Resume Next
lintUBound = UBound(arrParam)
llngError = Err.Number
If (llngError <> 0) Then : Err.Clear
On Error Goto 0
If (llngError = 0) And (lintUBound >= 0) Then : isEmptyArrayString = True
End Function
'##################################################
'## サブフォルダーのCSVファイル検索
'##
'## 引数１： サブディレクトリ―パス
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： 文字コード変換元CSVファイル一覧
'##
'##################################################
Sub getAllFiles(ByVal path, ByRef fso, ByRef filepath())
Dim files
Dim fol
Dim folders
Dim file
Set folders = fso.GetFolder(path).SubFolders
If IsObject(folders) Then
For Each fol In folders
Set files = fso.GetFolder(fol).files
If IsObject(files) Then
For Each file In files
If fso.GetExtensionName(file.path) = "csv" Then
Call addToArrayStrings(filepath, file.path)
End If
Next
End If
'サブフォルダーがあれば繰り返し探索する
Call getAllFiles(fol, fso, filepath)
Set files = Nothing
Next
End If
End Sub
'##################################################
'## エラーログリストを出力する関数
'##
'## 引数１： CSVファイルパス
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： 出力リスト
'##
'##################################################
Function createErrLogFile(ByVal fileName, ByRef fso, ByRef outputList)
'## 実行フラグ
Dim notxFlag
'## CSVデータ取得文字列
Dim substring
'## CSVデータ取得文字列区切り
Dim substrings
'## CSVデータ取得文字列区切り
Dim substrings_w
'## 文字変換エラー文字
Dim errorCode
'## CSVデータ読み込み回数
Dim icount
'## 結合文字列
Dim concatData
'## ループ処理用変 i
Dim i
'## 検証
Dim count
'|| ファイルオブジェクト
Dim file
'icountを初期化
icount = 0
count = 0
'文字交換エラーリスト(CSVファイル)をオブジェクト定義する
Set file = fso.OpenTextFile(fileName)
'文字交換エラーリストを開いて、ログ(１行目～）の中身を出力する
Do While file.AtEndOfStream = False
'取得した文字列をsubstringに格納する
substring = file.ReadLine
' エラー対象の文字コードの場合
If InStr(substring, "CD:") > 0 Then
'実行フラグをオン
notxFlag = True
'文字列をカンマ区切りで取得する
substrings = Split(substring, ",")
'配列errCodesに１件も要素が格納されていない場合
If isEmptyArrayString(outputList) = True Then
'エラー文字を格納する
errorCode = Replace(substrings(4), """", "")
'未定義拡張漢字以外のエラー文字の場合
'If Not InStr(errorCode, targetError) Then
'エラー内容に同じエラー内容が存在するかチェック
For i = 0 To UBound(outputList)
substrings_w = Split(outputList(i), vbTab)
'同じエラーが既に登録されている場合
'If StrComp(errorCode, substrings_w(4)) = 0 Then
If Instr(errorCode, substrings_w(4)) > 0 Then
'実行フラグをFLASE(実行しない)にして、ループから外れる
notxFlag = False
Exit For
End If
Next
'End If
End If
'実行フラグがTRUE(実行する)場合、配列へ各要素を格納する。
If (notxFlag) Then
'結合文字列に対象の項目データを結合した値をセットする。
concatData = substrings(0) & vbTab & substrings(1) & vbTab & substrings(2) & vbTab & substrings(3) & vbTab & Replace(substrings(4), """", "")
'結合文字列をリストに格納する。
Call addToArrayStrings(outputList, concatData)
'処理件数カウント
icount = icount + 1
WScript.StdOut.WriteLine count & "回目" & concatData
Else
WScript.StdOut.WriteLine count & "回目 対象文字無し：" & errorCode
End If
End If
count = count + 1
Loop
' csvファイルを閉じてメモリを解放する。
file.Close
Set file = Nothing
createErrLogFile = icount
End Function
'##################################################
'## CSVにデータを書き込みする関数
'##
'## 引数１： CSVファイルパス(書き込み先）
'## 引数２： FSO(ファイルシステムオブジェクト)
'## 引数３： データリスト
'##
'##################################################
Sub writeOutputCSV(writeFileName , ByRef fso, list())
'## CSVファイル(書込)
Dim f
'## ループ処理用変数i
Dim i
' CSVファイル（書込）が存在しない場合
If fso.FileExists(writeFileName) = False Then
'|| CSVファイルを作成したファイルオブジェクトを定義する。
Set f = fso.CreateTextFile(writeFileName, False)
Else
'|| ファイルオブジェクトを定義する（書込モード）
Set f = fso.OpenTextFile(writeFileName, 2)
End If
'リストのデータをファイル(CSV)へ出力する
For i = 0 To UBound(list)
f.WriteLine list(i)
Next
' csvファイルを閉じてメモリを解放する。
f.Close
Set f = Nothing
End Sub
'#################################################
'## 文字コード変換元のCSVファイル読込リスト作成
'##
'## 引数１：文字コード変換元CSVファイル一覧
'## 引数２：エラーログリスト
'## 引数３：CSVファイル読込リスト
'##
'#################################################
Sub readCSVFileCreate(filepath() , writedata(), ByRef filepath_target())
'## ループ処理用変 i
Dim i
'## ループ処理変数 j
Dim j
'## CSVファイル名
Dim csvfile
'## 文字区切り変換リスト
Dim substrings
' 読込CSVファイルを対象業務のみ抽出する。
For i = 0 To UBound(filepath)
'csvファイルのパス
csvfile = filepath(i)
'読込CSVファイルリストに同じCSVパスが存在するかチェック
For j = 0 To UBound(writedata)
'文字列をタブ区切りで取得する
substrings = Split(writedata(j), vbTab)
'状態が対象のCSVファイルである場合
If InStr(csvfile, substrings(0)) > 0 Then
'読込CSVファイルリストへ追加する
Call addToArrayStrings(filepath_target, csvfile)
'ループ処理から抜ける
Exit For
End If
Next
Next
End Sub
'#################################################
'## エラーデータ検索関数
'##
'## 引数１：エラーログリスト
'## 引数２：FSO(ファイルシステムオブジェクト)
'## 引数３：CSVファイル
'## 引数４：エラーデータリスト
'##
'#################################################
Sub SerachErrorData(writedata_substrings() , ByRef fso, csvfile, ByRef errCodesT())
'## ループ処理用変 i
Dim i
'## CSVファイルの最大行
Dim csvmaxrow
'## 検索対象行
Dim mpCSVFilebgnRow
'## 検索対象列
Dim mpCSVFilesetCol
'## 検索対象列インデックス
'Dim mpCSVFileColIndex
'## エラー変換結果データ
Dim gset
'## readlineデータ
Dim substring
'## readlineデータ（タブ区切り）
Dim substrings
'|| ファイルオブジェクト
Dim file
'CSVファイルの行数を取得する。
csvmaxrow = CLng(Val(fso.OpenTextFile(csvfile, 8).line))
'エラー文字対象行をセット(0行目から始まるため-１)
mpCSVFilebgnRow = CLng(Val(writedata_substrings(2)))
'エラー文字対象列をセット(0列目から始まるため-１)
mpCSVFilesetCol = CLng(Val(writedata_substrings(3)))
'CSVファイルをオブジェクト定義する
Set file = fso.OpenTextFile(csvfile)
With file
'csvの最大行数が対象の文字コード行数より小さい場合
If mpCSVFilebgnRow > csvmaxrow Then
'ファイルを閉じる
.Close
WScript.StdOut.WriteLine "探索中"& csvfile & "該当無し エラー１" & TypeName(mpCSVFilebgnRow) & " > " & TypeName(csvmaxrow)
'処理を終了する。
Exit Sub
End if
'取り込むCSVファイルの開始行の値だけ処理を繰り返す
For i = 1 To mpCSVFilebgnRow - 1
'最大行の場合、ループから抜ける
If i >= csvmaxrow Or .AtEndOfStream Then
Exit For
End If
'行参照位置を1つスキップする
.SkipLine
Next
WScript.StdOut.WriteLine "今のLine" & .line & "対象行" & mpCSVFilebgnRow
'EOF判定(ファイル末端）の場合、 処理を終了する。
If .AtEndOfStream Then
'ファイルを閉じる
.Close
WScript.StdOut.WriteLine "探索中" & csvfile & "該当無し エラー２"
'処理を終了する。
Exit Sub
End If
'指定行目の文字列を読み込む
substring = .ReadLine
'文字列をタブ区切りで取得する
substrings = Split(substring, vbTab)
'検索文字数の位置がCSVの最大文字数より大きい場合
If mpCSVFilesetCol > Len(substring) Then
'ファイルを閉じる
.Close
WScript.StdOut.WriteLine "探索中CSVファイル該当無し エラー３" & TypeName(mpCSVFilesetCol) & " > " & TypeName(Len(substring))
WScript.StdOut.WriteLine "探索中CSVファイル該当無し エラー３" & mpCSVFilesetCol & " > " & Len(substring)
'処理を終了する。
Exit Sub
End If
WScript.StdOut.WriteLine "CSVファイル名： " & csvfile
WScript.StdOut.WriteLine "探索データ検索対象： "& writedata_substrings(4) & "：" & substring
'文字化けしているエラー文字列を抽出する
For i = 0 To UBound(substrings)
'エラー文字列の場合
If InStr(CStr(substrings(i)), CStr(writedata_substrings(4))) > 0 Then
'エラー変換結果データを文字列に結合する。
gset = writedata_substrings(0) & vbTab & writedata_substrings(1) & vbTab & Replace(substrings(i), """", "") & vbTab & writedata_substrings(4)
'エラー文字(真)を格納
Call addToArrayStrings(errCodesT, gset)
'検索文字列がヒットしたらループから抜ける
WScript.StdOut.WriteLine "探索データ有り： "& writedata_substrings(4) & "：" & substrings(i)
Exit For
End If
Next
End With
'csvファイルを閉じる
file.Close
Set file = Nothing
End Sub
'################################
'##
'## Val関数
'## 引数１文字列
'##
'################################
Function Val(value)
Dim colMatches, match, submatch, sign, reg, exp, i, j, st
Val = 0
'COMの正規表現を使用すると型が自動変換される
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "([-0-9.]+)(E[+-]?[0-9]+)|([-0-9.]+)|(&H[0-9A-F]+)|(&O[0-9]+)"
reg.IgnoreCase = True
reg.Global = True
Set colMatches = reg.Execute(value)
For Each match In colMatches
For i = 0 To match.SubMatches.Count - 1
submatch = UCase(match.SubMatches(i))
If Instr(submatch, "E") = 1 Then
'連続Eを排除
submatch = Replace(submatch, "E", "")
sign = Mid(submatch, 1,1)
st = 1
If sign = "-" OR sign = "+" Then st = 2
If sign = "" Then submatch = submatch + "0"
exp = Mid(submatch, st)
If exp <> "" Then
'指数あり
exp = 10 ^ CLng(exp)
If sign = "-" Then
Val = Val / exp
Else
Val = Val * exp
End If
End If
Else
'指数なし
Val = Val & submatch
End If
'小数0.以外の先頭0を消去する
If Instr(Val, "0") = 1 And Instr(Val, "0.") <> 1 then
Val = Mid(Val, 2)
End If
Next
Next
'16進数と8進数対応
If Instr(value, "&") > 0 then
Val = CLng(Val)
End If
'末尾"."を除去
For i = Len(Val) To 0 Step -1
If Right(Val, 1) = "." Then
Val = Left(Val, i-1)
Else
Exit For
End If
Next
'先頭"."は0を頭に追加
If Instr(Val, ".") = 1 then
Val = "0." & Replace(Val, ".", "")
End If
'変換対象外は0とする
If Val = "" OR IsNumeric(Val) = False Then Val = 0
Set reg = Nothing
End Function