VBScriptのプログラムについて、
度々の内容ですみません。
解決していませんので、質問させてください。
・vbsファイルにテキストファイルをドラッグする
・InputBoxに任意の文字列を入力する
・変換しますか?と問われるため、
「はい」を押したらTextStreamオブジェクトを1行ごとに読み込む
・見つかった文字列を置換し、その文字列が含まれた全ての行を
別名のテキストファイルに抽出する
例:(ファイルA)
asdfghjk.vbs
1:あいうえお
2:かきくけこ
3:あいうえお
⇒ (ファイルB)
asdfghjk_20151217.vbs
1:をふうえお
2:をふうえお
・「いいえ」を押したら変換しないで別名のテキストファイルに
見つかった文字列が含む行をそのまま抽出する
・見つからなかった場合、何もしない
(別名のテキストファイルを作成しない)
<プラグラム>
Option Explicit
'引数の取得
Function GetArg()
Dim objParm
GetArg = ""
Set objParm = Wscript.Arguments
If objParm.Count = 0 Then
WScript.Echo "引数が指定されていません。"
ElseIf objParm.Count >= 2 Then
WScript.Echo "2つ以上のファイルが指定されています。"
Else
GetArg = objParm(0)
End If
End Function
'文字列入力
Function Search(Msg)
Search = InputBox(Msg, "整形処理")
If IsEmpty(Search) Then
MsgBox ("キャンセルされました。")
Search = ""
ElseIf Search = "" Then
MsgBox "文字列が入力されていません。" & vbCr _
& "入力し直してください。", vbOKOnly, "Error"
Search = ""
ElseIf Search = " " or Search = " " Then
MsgBox "空白が入力されています。" & vbCr _
& "入力し直してください。", vbOKOnly, "Error"
Search = ""
End If
End Function
'メイン処理
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim strFile, strSearch, strChange, strMsgBox
Dim objFSO, strText, objRead, objWrite, strNewText
Dim lonDate, strWork, strBuffer
strFile = GetArg()
If strFile = "" Then
WScript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(objFSO.GetExtensionName(strFile)) <> "txt" Then
MsgBox "テキストファイル以外が指定されています。" & vbCr _
& "指定し直してください。", vbExclamation, "Error"
WScript.Quit
End If
strSearch = Search("抽出したい文字列を入力してください。")
If strSearch = "" Then
WScript.Quit
End If
strMsgBox = MsgBox("『" & strSearch & "』" & "を抽出します。" & vbCr _
& "変換しますか?", vbYesNo + vbQuestion, "確認")
If strMsgBox <> vbYes Then
MsgBox ("変換をスキップします。")
Else
strChange = Search("どの文字列に変換しますか?")
End If
lonDate = "_" & Year(Now()) & right( "00" & Month(Now()),2) & right( "00" & Day(Now()),2)
Set objRead = objFSO.OpenTextFile(strFile, 1)
strBuffer = ""
Do Until objRead.AtEndOfStream = True
strText = objRead.ReadLine
If InStr(1, strText, strSearch, vbTextCompare) > 0 Then
If strMsgBox <> vbNo Then
strWork = Replace(strText, strSearch, strChange, vbTextCompare)
strBuffer = strBuffer & strWork & vbCrLf
End If
End If
Loop
objRead.Close
Set objRead = Nothing
If strBuffer <> "" Then
If strMsgBox = vbNo Then
strNewText = objFSO.BuildPath( _
objFSO.GetParentFolderName(strFile), _
objFSO.GetBaseName(strFile) & _
lonDate & "." & objFSO.GetExtensionName(strFile))
Set objWrite = objFSO.OpenTextFile(strNewText, 2, True)
objWrite.Close
Else
strNewText = objFSO.BuildPath( _
objFSO.GetParentFolderName(strFile), _
objFSO.GetBaseName(strFile) & _
lonDate & "." & objFSO.GetExtensionName(strFile))
Set objWrite = objFSO.OpenTextFile(strNewText, 2, True)
objWrite.Write(strBuffer)
objWrite.Close
End If
Else
MsgBox "『" & strSearch & "』" & "が見つかりませんでした。"
WScript.Quit
End If
Set objWrite = Nothing
Set objFSO = Nothing
WScript.Sleep 1000
MsgBox ("文字列の抽出が完了しました。")
現状の動作として、抽出したい文字列を入力した後に
変換しますか?の問いで「いいえ」を押すと、
見つかりませんでした、という結果を返してしまいます。
※実際はテキストファイルにその文字列は存在しています。
「いいえ」を押すと、変換をスキップして以降の処理を行いたいのですが、
どのように記述すればよろしいでしょうか?
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
スキップ後の処理を書いてfunctionからexitしては?
test()
function test()
strSearch="テスト文字列"
strMsgBox = MsgBox("『" & strSearch & "』" & "を抽出します。" & vbCr _
& "変換しますか?", vbYesNo + vbQuestion, "確認")
If strMsgBox <> vbYes Then
msgbox "変換をスキップします。・・・変換スキップ処理"
exit function
Else
msgbox "変換を続けます。"
End If
msgbox "その後の処理"
end function
ご丁寧に回答いただき、有難うございます。
今回はfunctionは使いませんでしたが、
カスタマイズでもう少しコードを短くしていきたいと思います。
No.2
- 回答日時:
Option Explicit
'引数の取得
Function GetArg()
Dim objParm
GetArg = ""
Set objParm = Wscript.Arguments
If objParm.Count = 0 Then
WScript.Echo "引数が指定されていません。"
ElseIf objParm.Count >= 2 Then
WScript.Echo "2つ以上のファイルが指定されています。"
Else
GetArg = objParm(0)
End If
End Function
'文字列入力
Function Search(Msg)
Search = InputBox(Msg, "整形処理")
If IsEmpty(Search) Then
MsgBox ("キャンセルされました。")
Search = ""
ElseIf Search = "" Then
MsgBox "文字列が入力されていません。" & vbCr _
& "入力し直してください。", vbOKOnly, "Error"
Search = ""
ElseIf Search = " " or Search = " " Then
MsgBox "空白が入力されています。" & vbCr _
& "入力し直してください。", vbOKOnly, "Error"
Search = ""
End If
End Function
'メイン処理
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim strFile, strSearch, strChange, strMsgBox
Dim objFSO, strText, objRead, objWrite, strNewText
Dim lonDate, strWork, strBuffer
strFile = GetArg()
If strFile = "" Then
WScript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(objFSO.GetExtensionName(strFile)) <> "txt" Then
MsgBox "テキストファイル以外が指定されています。" & vbCr _
& "指定し直してください。", vbExclamation, "Error"
WScript.Quit
End If
strSearch = Search("抽出したい文字列を入力してください。")
If strSearch = "" Then
WScript.Quit
End If
strMsgBox = MsgBox("『" & strSearch & "』" & "を抽出します。" & vbCr _
& "変換しますか?", vbYesNo + vbQuestion, "確認")
If strMsgBox <> vbYes Then
MsgBox ("変換をスキップします。")
Else
strChange = Search("どの文字列に変換しますか?")
End If
Set objRead = objFSO.OpenTextFile(strFile, 1)
strBuffer = ""
Do Until objRead.AtEndOfStream = True
strText = objRead.ReadLine
If InStr(1, strText, strSearch, vbTextCompare) > 0 Then
If strMsgBox <> vbYes Then
strWork = strText
Else
strWork = Replace(strText, strSearch, strChange, vbTextCompare)
End If
strBuffer = strBuffer & strWork & vbCrLf
End If
Loop
objRead.Close
Set objRead = Nothing
If strBuffer <> "" Then
lonDate = "_" & Year(Now()) & right( "00" & Month(Now()),2) & right( "00" & Day(Now()),2)
strNewText = objFSO.BuildPath( _
objFSO.GetParentFolderName(strFile), _
objFSO.GetBaseName(strFile) & _
lonDate & "." & objFSO.GetExtensionName(strFile))
Set objWrite = objFSO.OpenTextFile(strNewText, 2, True)
objWrite.Write(strBuffer)
objWrite.Close
Else
MsgBox "『" & strSearch & "』" & "が見つかりませんでした。"
WScript.Quit
End If
Set objWrite = Nothing
Set objFSO = Nothing
WScript.Sleep 1000
MsgBox ("文字列の抽出が完了しました。")
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルでアルファベットか数...
-
C#で年月を比較する
-
VBAでの Replace関数で、ワイル...
-
EXCELで=より左の文字を一括で...
-
文字列からタブコードを取り除...
-
Excelで3E8を3.00E+8にしない方...
-
Excelで指数表現しないようにす...
-
VBの「As String * 128」とは?
-
エクセルで文字列をtxtファイル...
-
ダブルコーテーションでアンド...
-
エクセルで文字列の最大値を抽...
-
VBA2005 16進を2桁で表示したい。
-
MS SQLServer のSQLで文字列の...
-
同一セル内に関数と文字列を同...
-
CSV書込みの際、カンマで位置が...
-
16進数を10進数に簡単に変換す...
-
【Excel VBA】複数ある特定の文...
-
Msgboxの×が押されたとき
-
1 OR 1=1 は どんな論理(約束事...
-
アクセスでのインポート時の改...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルでアルファベットか数...
-
EXCELで=より左の文字を一括で...
-
文字列からタブコードを取り除...
-
VBAでの Replace関数で、ワイル...
-
Excelで指数表現しないようにす...
-
Excelで3E8を3.00E+8にしない方...
-
エクセルで文字列をtxtファイル...
-
【Excel VBA】複数ある特定の文...
-
Left関数とRight関数を合わせた...
-
同一セル内に関数と文字列を同...
-
アクセスで特定の数字以外(複...
-
MS SQLServer のSQLで文字列の...
-
エクセルで文字列の最大値を抽...
-
VBA2005 16進を2桁で表示したい。
-
ORCLEでの小数の表示方法の変更...
-
エクセル 数値データを桁をそ...
-
VBの「As String * 128」とは?
-
CStringの文字列検索&抜き出し...
-
エクセルでセル内の文字列の最...
-
Msgboxの×が押されたとき
おすすめ情報