テキストファイルから指定した文字列を含む行を抽出するVBScriptの一般化
2021年04月25日
前回、ログファイルから該当の文字列を含む行だけ抽出するVBScriptを作った。
抽出する文字列を追加する場合、プログラムを修正しないといけないってのは
使いづらいと思い、抽出条件をINPUTBOXで指定するバージョンを作ってみた。
紙ベースでしっかり設計したから1時間かからずに完成。
毎度INPUTBOXで文字列を入力するのはデバッグ中もだるさを感じるとこなので、
オプション設定にした方が使いやすいか・・・。①か②お好みで。
①strFilter = InputBox("フィルタ条件を入力してください。" & chr(10) & "ORは†、ANDは‡で指定します。","フィルタ条件入力")
②strFilter = "ui‡com†アカ"
カンマやアスタリスクを演算文字列として使うことも考えたけど、
演算文字列はログ抽出できないので、†と‡を使うことにした。
演算文字列は‡を先に計算する。たとえば
A†B‡C とした場合は、Aまたは(BかつC)を含む文字列を取得する。
‡の数が未知数だったので、Dictionary配列を使うことにした。
うまく使えば結構便利かも!!
◆使用方法◆(変更なし)
ソースをメモ帳にコピーし、「.vbs」形式で保存。
ログファイルを保存したファイルのアイコンにドラッグドロップする。
(複数ファイルにも対応)
以下、ソース。
抽出する文字列を追加する場合、プログラムを修正しないといけないってのは
使いづらいと思い、抽出条件をINPUTBOXで指定するバージョンを作ってみた。
紙ベースでしっかり設計したから1時間かからずに完成。
毎度INPUTBOXで文字列を入力するのはデバッグ中もだるさを感じるとこなので、
オプション設定にした方が使いやすいか・・・。①か②お好みで。
①strFilter = InputBox("フィルタ条件を入力してください。" & chr(10) & "ORは†、ANDは‡で指定します。","フィルタ条件入力")
②strFilter = "ui‡com†アカ"
カンマやアスタリスクを演算文字列として使うことも考えたけど、
演算文字列はログ抽出できないので、†と‡を使うことにした。
演算文字列は‡を先に計算する。たとえば
A†B‡C とした場合は、Aまたは(BかつC)を含む文字列を取得する。
‡の数が未知数だったので、Dictionary配列を使うことにした。
うまく使えば結構便利かも!!
◆使用方法◆(変更なし)
ソースをメモ帳にコピーし、「.vbs」形式で保存。
ログファイルを保存したファイルのアイコンにドラッグドロップする。
(複数ファイルにも対応)
以下、ソース。
'-----------------------------------------------------------
Option Explicit
'テキストファイルから指定した文字列を含む行を抽出するVBScriptの一般化
'-----------------------------------------------------------オプション設定ここから
'ログファイルの文字コードを指定
'const strCode = "UTF-8" ' 文字コード指定 "Shift-Jis" "UTF-8"
const strCode = "Shift-Jis" ' 文字コード指定 "Shift-Jis" "UTF-8"
'検索モード if Instr(1,lineStr,KeyWord1,cMode) > 0
const cMode = 1 '0:バイナリ 1:テキスト ※バイナリだと大文字と小文字を区別
'Instr関数は、文字列を検索して位置を返す。なければ0を返す。開始位置を指定しないとモード指定できない
'検索文字列
dim strFilter
strFilter = "ui‡com†アカ"
'strFilter = InputBox("フィルタ条件を入力してください。" & chr(10) & "ORは†、ANDは‡で指定します。","フィルタ条件入力")
if strFilter = "" then WScript.Quit 'メイン処理終了
'-----------------------------------------------------------オプション設定ここまで
'ドラッグドロップでファイルを印刷するスクリプト
'http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
'ファイル名の末尾に更新日時を付与するVBScript
'http://gren-dken.hatenablog.com/entry/2013/08/22/000119
'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
WScript.Quit
End If
dim targetPath,changePath
dim FSO
'----------------------------------------------------------------------------------------------------
' ファイルシステムオブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
'-------------------------------------------------------------------------------------------------------
' フォルダ内ファイルリスト出力
for each targetPath In WScript.Arguments
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダかファイルかを判定する
If FSO.FolderExists(targetPath) then
' is folder.
WScript.Echo "フォルダがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
ElseIf FSO.FileExists(targetPath) then
' is file.
else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
' メインモジュール呼び出し
Call TextFilterMain(targetPath,strFilter)
Next
set FSO = nothing
WScript.Quit 'メイン処理終了
'-----------------------------------------------------------実質ここから
Sub TextFilterMain(targetPath,strFilter)
'フィルタ条件の抽出
Dim ArrD, cntD
Dim ArrDD, cntDD()
Dim fFlag
ArrD = Split(strFilter,"†")
cntD = Ubound(ArrD)
redim cntDD(cntD) 'サイズを指定しないと配列は動かない
Dim Dic 'Create a variable Dicは配列サイズを気にしなくてよい
Set Dic = CreateObject("Scripting.Dictionary")
dim i , j
for i = 0 to cntD
if Instr(ArrD(i), "‡" ) > 0 then
ArrDD = Split(ArrD(i),"‡")
cntDD(i) = Ubound(ArrDD)
for j = 0 to cntDD(i)
Dic.Add i & "‡" & j , ArrDD(j)
next
else
cntDD(i) = 0
end if
next
'https://neos21.net/blog/2016/03/25-01.html
dim outputPath :outputPath = createOutputFilePath( targetPath ) '出力ファイルフルネーム
Dim strLine'入力用バッファ
dim oBuf '出力用バッファ
' 読み込みファイルの指定 (相対パスなのでこのスクリプトと同じフォルダに置いておくこと)
Dim input
Set input = CreateObject("ADODB.Stream")
input.Type = 2 ' 1:バイナリ・2:テキスト
input.Charset = strCode ' 文字コード指定
input.Open ' Stream オブジェクトを開く
input.LoadFromFile targetPath ' ファイルを読み込む
' 書き出しファイルの指定 (今回は新規作成する)
Dim output: Set output = CreateObject("ADODB.Stream")
output.Type = 2
output.Charset = strCode
output.Open
' 読み込みファイルから1行ずつ読み込み、書き出しファイルに書き出すのを最終行まで繰り返す
Dim records
Dim lineStr
Do Until input.EOS
lineStr = input.ReadText(-2) ' -1:全行読み込み・-2:一行読み込み
'◆フィルタ判定処理◆
for i = 0 to cntD
if cntDD(i) = 0 then
fFlag = Instr(lineStr, ArrD(i))
else
for j = 0 to cntDD(i)
fFlag = Instr(lineStr, Dic(i & "‡" & j)) 'Dic.Add i & "‡" & j , ArrDD(j)
if fFlag = 0 then exit For
next
end if
if fFlag > 0 then exit For
next
'◆文字列フィルタ処理◆
if fFlag > 0 then
output.WriteText lineStr, 1 ' 0:文字列のみ書き込み・1:文字列 + 改行を書き込み
end if
Loop '読み込みながら書き込みは重いかも・・・
' 書き出しファイルの保存
output.SaveToFile outputPath, 2 '1:指定ファイルがなければ新規作成・2:ファイルがある場合は上書き
' Stream を閉じる
input.Close
output.Close
'ログファイルを開く
call OpenTextFileShell(outputPath)
End Sub
'------------------------------
' 出力ファイル名の生成
'------------------------------
Function createOutputFilePath(targetPath )
const strHead = "■" 'ファイル名の先頭につける文字
const strFoot = "解析結果" 'ファイル名のお尻につける文字
dim fo: Set fo = FSO.GetFile(targetPath) 'FSOはグローバルで宣言
' ファイルパス分割
Dim targetDir: targetDir = FSO.GetParentFolderName(targetPath)
Dim targetBaseName: targetBaseName = FSO.GetBaseName(targetPath)
Dim targetExt: targetExt = FSO.GetExtensionName(targetPath)
' 変更後ファイルパス生成し、返却
createOutputFilePath = targetDir & "\" & strHead & targetBaseName & "_" & strFoot & "." & targetExt
End Function
'------------------------------
' CMDで指定したファイルを開く
'------------------------------
sub OpenTextFileShell(FulName)
Dim objWshShell
'シェルオブジェクトの作成
Set objWshShell = WScript.CreateObject("WScript.Shell")
'シェルの実行
objWshShell.Run FulName
end sub
Option Explicit
'テキストファイルから指定した文字列を含む行を抽出するVBScriptの一般化
'-----------------------------------------------------------オプション設定ここから
'ログファイルの文字コードを指定
'const strCode = "UTF-8" ' 文字コード指定 "Shift-Jis" "UTF-8"
const strCode = "Shift-Jis" ' 文字コード指定 "Shift-Jis" "UTF-8"
'検索モード if Instr(1,lineStr,KeyWord1,cMode) > 0
const cMode = 1 '0:バイナリ 1:テキスト ※バイナリだと大文字と小文字を区別
'Instr関数は、文字列を検索して位置を返す。なければ0を返す。開始位置を指定しないとモード指定できない
'検索文字列
dim strFilter
strFilter = "ui‡com†アカ"
'strFilter = InputBox("フィルタ条件を入力してください。" & chr(10) & "ORは†、ANDは‡で指定します。","フィルタ条件入力")
if strFilter = "" then WScript.Quit 'メイン処理終了
'-----------------------------------------------------------オプション設定ここまで
'ドラッグドロップでファイルを印刷するスクリプト
'http://chuckischarles.hatenablog.com/entry/2018/10/29/002921
'ファイル名の末尾に更新日時を付与するVBScript
'http://gren-dken.hatenablog.com/entry/2013/08/22/000119
'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
WScript.Quit
End If
dim targetPath,changePath
dim FSO
'----------------------------------------------------------------------------------------------------
' ファイルシステムオブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
'-------------------------------------------------------------------------------------------------------
' フォルダ内ファイルリスト出力
for each targetPath In WScript.Arguments
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダかファイルかを判定する
If FSO.FolderExists(targetPath) then
' is folder.
WScript.Echo "フォルダがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
ElseIf FSO.FileExists(targetPath) then
' is file.
else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
' メインモジュール呼び出し
Call TextFilterMain(targetPath,strFilter)
Next
set FSO = nothing
WScript.Quit 'メイン処理終了
'-----------------------------------------------------------実質ここから
Sub TextFilterMain(targetPath,strFilter)
'フィルタ条件の抽出
Dim ArrD, cntD
Dim ArrDD, cntDD()
Dim fFlag
ArrD = Split(strFilter,"†")
cntD = Ubound(ArrD)
redim cntDD(cntD) 'サイズを指定しないと配列は動かない
Dim Dic 'Create a variable Dicは配列サイズを気にしなくてよい
Set Dic = CreateObject("Scripting.Dictionary")
dim i , j
for i = 0 to cntD
if Instr(ArrD(i), "‡" ) > 0 then
ArrDD = Split(ArrD(i),"‡")
cntDD(i) = Ubound(ArrDD)
for j = 0 to cntDD(i)
Dic.Add i & "‡" & j , ArrDD(j)
next
else
cntDD(i) = 0
end if
next
'https://neos21.net/blog/2016/03/25-01.html
dim outputPath :outputPath = createOutputFilePath( targetPath ) '出力ファイルフルネーム
Dim strLine'入力用バッファ
dim oBuf '出力用バッファ
' 読み込みファイルの指定 (相対パスなのでこのスクリプトと同じフォルダに置いておくこと)
Dim input
Set input = CreateObject("ADODB.Stream")
input.Type = 2 ' 1:バイナリ・2:テキスト
input.Charset = strCode ' 文字コード指定
input.Open ' Stream オブジェクトを開く
input.LoadFromFile targetPath ' ファイルを読み込む
' 書き出しファイルの指定 (今回は新規作成する)
Dim output: Set output = CreateObject("ADODB.Stream")
output.Type = 2
output.Charset = strCode
output.Open
' 読み込みファイルから1行ずつ読み込み、書き出しファイルに書き出すのを最終行まで繰り返す
Dim records
Dim lineStr
Do Until input.EOS
lineStr = input.ReadText(-2) ' -1:全行読み込み・-2:一行読み込み
'◆フィルタ判定処理◆
for i = 0 to cntD
if cntDD(i) = 0 then
fFlag = Instr(lineStr, ArrD(i))
else
for j = 0 to cntDD(i)
fFlag = Instr(lineStr, Dic(i & "‡" & j)) 'Dic.Add i & "‡" & j , ArrDD(j)
if fFlag = 0 then exit For
next
end if
if fFlag > 0 then exit For
next
'◆文字列フィルタ処理◆
if fFlag > 0 then
output.WriteText lineStr, 1 ' 0:文字列のみ書き込み・1:文字列 + 改行を書き込み
end if
Loop '読み込みながら書き込みは重いかも・・・
' 書き出しファイルの保存
output.SaveToFile outputPath, 2 '1:指定ファイルがなければ新規作成・2:ファイルがある場合は上書き
' Stream を閉じる
input.Close
output.Close
'ログファイルを開く
call OpenTextFileShell(outputPath)
End Sub
'------------------------------
' 出力ファイル名の生成
'------------------------------
Function createOutputFilePath(targetPath )
const strHead = "■" 'ファイル名の先頭につける文字
const strFoot = "解析結果" 'ファイル名のお尻につける文字
dim fo: Set fo = FSO.GetFile(targetPath) 'FSOはグローバルで宣言
' ファイルパス分割
Dim targetDir: targetDir = FSO.GetParentFolderName(targetPath)
Dim targetBaseName: targetBaseName = FSO.GetBaseName(targetPath)
Dim targetExt: targetExt = FSO.GetExtensionName(targetPath)
' 変更後ファイルパス生成し、返却
createOutputFilePath = targetDir & "\" & strHead & targetBaseName & "_" & strFoot & "." & targetExt
End Function
'------------------------------
' CMDで指定したファイルを開く
'------------------------------
sub OpenTextFileShell(FulName)
Dim objWshShell
'シェルオブジェクトの作成
Set objWshShell = WScript.CreateObject("WScript.Shell")
'シェルの実行
objWshShell.Run FulName
end sub
PR
Comment