【VBScript】ファイル整形

質問

以下の流れのプログラムを作成したく、
進めています。
下記コードの続きは、どういった感じで作りこんでいけば、
この操作が実現しますでしょうか。
恐れ入りますが、ご教示いただけますと幸いです。

・vbsファイルにテキストファイルをドラッグする
・インプットボックスに抽出したい文字列を入力する
・テキストファイルを読み込んで、抽出した文字列を含む行を注した
　別名のテキストファイル(末尾に_YYYYMMDDをつける)を生成する

Option Explicit

Dim intc, strf, strArguments, strInput, strmsgbox

intc = 0

If WScript.Arguments.Count = 0 Then

WScript.Echo "引数が指定されていません。"

Else

For Each strArguments In WScript.Arguments

intc = intc + 1

strf = strArguments

Next

If intc > 1 Then

MsgBox "2つ以上のファイルが指定されています。" & vbCr _

& "ファイルを指定し直してください。", 48, "Error"

Else

WScript.Echo strf

strInput = InputBox("抽出したい文字列を入力してください。")

strmsgbox = MsgBox strInput & "を抽出しました。" & vbCr _

& strInput & "を変換しますか？", 4 + 32 + 0, "確認"

End If

End If

回答No.1

NotFound404

ん～～見づらい。
余計な空行があったり、If ～ End If間が長かったり、・・・。
・vbsファイルにテキストファイルをドラッグする
・インプットボックスに抽出したい文字列を入力する
・テキストファイルを読み込んで、抽出した文字列を含む行を注した？意味不明
・別名のテキストファイル(末尾に_YYYYMMDDをつける)を生成する
ということで考えると大体こんな組立かな？と。

Option Explicit
Dim strInput
Dim oFS,oFile,oFileNew
Dim v,Buf
Dim MyPath ,MyName,MyDate,MyExt
Const ForReading = 1,ForWriting = 2,ForAppending = 8

'Arguementsチェック
If WScript.Arguments.Count <> 1 Then
WScript.Echo "引数を必ず一個だけ指定してください。それ以外では機能しません。"
WScript.Quit
End if

'抽出値取得
strInput = InputBox("抽出したい文字列を入力してください。")
If strInput= "" Then
WScript.Echo "中止します"
WScript.quit
end if

'ファイル読み込み
Set oFS = CreateObject("Scripting.FilesystemObject")
Set oFile = oFS.OpenTextFile(WScript.Arguments(0),forReading)
Do Until oFile.AtEndofStream
v=oFile.ReadLine
If Instr(1,v,strInput,vbTextCompare) > 0 Then 'vbBinaryCompare の方かも？
Buf = Buf & v & VBCrLf
End If
Loop

oFile.Close

If IsEmpty(Buf) Then
WScript.Echo "抽出文字列" & StrInput & "はありませんでした"
Wscript.quit
End If

'抽出文字があった場合に新規ファイルにBuf書き込み
MyPath = oFS.GetParentFolderName(WScript.Arguments(0)) & "\"
MyName = oFS.GetBaseName(WScript.Arguments(0))
'MyDate = "_" & Replace(FormatDatetime(Date,2),"/","") '環境に依存する可能性があるので下にしました
MyDate = "_" & Year(Date) _
& String(2-len(Month(Date)),"0") & Month(Date) _
& String(2-len(Day(Date)),"0") & Day(Date)
MyExt = "." & oFS.GetExtensionName(WScript.Arguments(0))

Set oFileNew = oFS.CreateTextFile(MyPath & MyName & MyDate & MyExt) '※既存のファイルがあれば無警告上書き
oFileNew.Write Buf
oFileNew.Close
WScript.Echo "終了しました"

補足

ご丁寧で詳細な回答、有難うございます。

すみません、追加で質問させてください。

InputBoxの処理をOKとキャンセルで分岐させたく、
頂いたコードから以下に修正しました。

strInput = InputBox("抽出したい文字列を入力してください。")
If strInput = "" Then
If strInput = True Then
MsgBox "文字列が入力されていません。" & vbCr _
& "入力し直してください。", 0, "Error"
WScript.Quit 8
End If
WScript.Quit 8
End If

OKなら"文字列が入力～"
キャンセルなら何も表示しないで終了させたいですが、
足りない部分はありますでしょうか？