【VBScript】文字列変換&抽出
VBScriptで以下の動作を実現させたいと思っています。
・vbsファイルにテキストファイルをドラッグする
・InputBoxに任意の文字列を入力する
・変換しますか？と問われるため、
「はい」を押したらTextStreamオブジェクトを1行ごとに読み込む
・見つかった文字列を置換し、その文字列が含まれた全ての行を
別名のテキストファイルに抽出する
例：(ファイルA)
asdfghjk.vbs
1:あいうえお
2:かきくけこ
3:あいうえお
⇒ (ファイルB)
asdfghjk_20151217.vbs
1:をふうえお
2:をふうえお
・「いいえ」を押したら変換しないで別名のテキストファイルに
見つかった文字列が含む行をそのまま抽出する
・見つからなかった場合、何もしない
(別名のテキストファイルを作成しない)
前のプログラムだと、文字列が見つからなかった場合でも
空のテキストファイルを作成していました。
これを防ぐために、以下のように修正したのですが、
オブジェクトが存在しない旨のエラーが出て機能してくれません。
どこが問題なのでしょうか？
また、次のステップとして、変換処理を加えたいのですが、
InputBoxを再び使用せずに置換することは可能なのでしょうか？
恐れ入りますが、回答いただけますと幸いです。
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objParm, strFile, strX, lonMsgBox
Dim objFSO, objOpen, strText, strNewFile, objTS
Dim lonDate, v, strBuffer
Set objParm = Wscript.Arguments
If objParm.Count = 0 Then
WScript.Echo "引数が指定されていません。"
WScript.Quit
ElseIf objParm.Count >= 2 Then
WScript.Echo "2つ以上のファイルが指定されています。"
WScript.Quit
Else
strFile = objParm(0)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.GetExtensionName(strFile) <> "txt" Then
WScript.Echo objFSO.GetExtensionName(strFile)
MsgBox "テキストファイル以外が指定されています。" & vbCr _
& "ファイルを指定し直してください。", vbExclamation, "Error"
WScript.Quit
End If
strX = InputBox("抽出したい文字列を入力してください。", "変換処理")
If IsEmpty(strX) Then
MsgBox ("キャンセルされました。")
WScript.Quit
ElseIf strX = "" Then
MsgBox "文字列が入力されていません。" & vbCr _
& "入力し直してください。", vbOKOnly, "Error"
WScript.Quit
End If
lonMsgBox = MsgBox(strX & "を抽出します。" & vbCr _
& "変換しますか？", vbYesNo + vbQuestion, "確認")
If lonMsgBox <> vbYes Then
MsgBox ("変換をスキップします。")
End If
lonDate = "_" & Year(Now()) & right( "00" & Month(Now()),2) & right( "00" & Day(Now()),2)
strNewFile = objFSO.BuildPath( _
objFSO.GetParentFolderName(strFile), _
objFSO.GetBaseName(strFile) & _
lonDate & "." & objFSO.GetExtensionName(strFile))
Set objOpen = objFSO.OpenTextFile(strFile, ForReading)
Do Until objOpen.AtEndOfStream = True
strText = objOpen.ReadLine
v = strText.ReadLine
If InStr(v, strX, vbTextCompare) > 0 Then
strBuffer = strBuffer & v & VBCrLf
End If
Loop
objOpen.Close
Set objOpen = Nothing
If IsEmpty(strBuffer) Then
MsgBox strX & "が見つかりませんでした。"
WScript.Quit
End If
Set objTS = objFSO.OpenTextFile(strNewFile, ForWriting, True)
objTS.WriteLine strBuffer
objTS.Close
Set objTS = Nothing
Set objFSO = Nothing
WScript.Sleep 1000
MsgBox ("文字列の抽出が完了しました。")
お礼
ありがとうございます。 たすかりました。