• 締切済み

【VBScript】プログラム改良

VBScriptのプログラムについて、 回答頂きたく投稿しました。 以下を実行すると、 65行目で「'End'がありません。」とエラー表示されてしまいます。 End Ifは入れているはずですが、どこが問題なのでしょうか？ またIfステートメントを少し減らしたいのですが、 どうすればシンプルな形になりますでしょうか？ 恐れ入りますが、アドバイス頂ければ幸いです。 Option Explicit Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS intCount = 0 If WScript.Arguments.Count = 0 Then WScript.Echo "引数が指定されていません。" WScript.Quit End If For Each strArg In WScript.Arguments intCount = intCount + 1 strFile = strArg Next Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.GetExtensionName(strFile) <> "txt" Then If intCount > 1 Then MsgBox "2つ以上のファイルが指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" WScript.Quit Else MsgBox "テキストファイル以外が指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" WScript.Quit End If Else strX = InputBox("抽出したい文字列を入力してください。", "変換処理") If strX <> "" Then lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr _ & "変換しますか？", 4 + 32 + 0, "確認") If lonmsgbox = 6 Then strNewFile = objFSO.BuildPath( _ objFSO.GetParentFolderName(strFile), _ objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) Set objOpen = objFSO.OpenTextFile(strFile, 1) Do Until objOpen.AtEndOfStream = True strText = objOpen.ReadLine If InStr(strText, strX) > 0 Then objTS.WriteLine strText End If Loop objTS.Close Set objTS = Nothing objOpen.Close Set objFSO = Nothing WScript.Sleep 1000 MsgBox ("文字列の抽出が完了しました。") Else MsgBox ("処理を中断します。") End If End If ElseIf IsEmpty(strX) then MsgBox ("キャンセルされました。") WScript.Quit Else MsgBox "文字列が入力されていません。" & vbCr _ & "入力し直してください。", 0, "Error" WScript.Quit End If

みんなの回答

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.4

参考に Option Explicit Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS If WScript.Arguments.Count = 0 Then 　WScript.Echo "引数が指定されていません。" 　WScript.Quit ElseIf WScript.Arguments.Count >= 2 Then 　MsgBox "2つ以上のファイルが指定されています。" & vbCr _ 　　& "ファイルを指定し直してください。", 48, "Error" 　WScript.Quit End If strFile = WScript.Arguments.Item(0) Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.GetExtensionName(strFile) <> "txt" Then 　MsgBox "テキストファイル以外が指定されています。" & vbCr _ 　　& "ファイルを指定し直してください。", 48, "Error" 　WScript.Quit End if strX = InputBox("抽出したい文字列を入力してください。", "変換処理") If IsEmpty(strX) then 　MsgBox "キャンセルされました。" 　WScript.Quit ElseIf strX = "" Then 　MsgBox "文字列が入力されていません。" & vbCr _ 　　& "入力し直してください。", 0, "Error" 　　WScript.Quit End If lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr _ 　　& "変換しますか？", vbYesNo + vbQuestion, "確認") If lonmsgbox <> vbYes Then 　MsgBox "処理を中断します。" 　WScript.Quit End If strNewFile = objFSO.BuildPath(objFSO.GetParentFolderName(strFile), _ 　　objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) Set objOpen = objFSO.OpenTextFile(strFile, 1) Do Until objOpen.AtEndOfStream = True 　strText = objOpen.ReadLine 　If InStr(strText, strX) > 0 Then 　　objTS.WriteLine strText 　End If Loop objTS.Close Set objTS = Nothing objOpen.Close Set objFSO = Nothing MsgBox "文字列の抽出が完了しました。"

  • Prome_Lin
  • ベストアンサー率42% (201/470)
回答No.3

再び「No.2」です。 01：Option Explicit 02：Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS 03：intCount = 0 04：If WScript.Arguments.Count = 0 Then 05：　　WScript.Echo "引数が指定されていません。" 06：　　WScript.Quit 07：End If 08：For Each strArg In WScript.Arguments 09：　　intCount = intCount + 1 10：　　strFile = strArg 11：Next 12：Set objFSO = CreateObject("Scripting.FileSystemObject") 13：If objFSO.GetExtensionName(strFile) <> "txt" Then 14：　　If intCount > 1 Then 15：　　　　MsgBox "2つ以上のファイルが指定されています。" & vbCr & "ファイルを指定し直してください。", 48, "Error" 16：　　　　WScript.Quit 17：　　Else 18：　　　　MsgBox "テキストファイル以外が指定されています。" & vbCr & "ファイルを指定し直してください。", 48, "Error" 19：　　　　WScript.Quit 20：　　End If 21：Else 22：　　strX = InputBox("抽出したい文字列を入力してください。", "変換処理") 23：　　If strX <> "" Then 24：　　　　lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr & "変換しますか？", 4 + 32 + 0, "確認") 25：　　　　If lonmsgbox = 6 Then 26：　　　　　　strNewFile = objFSO.BuildPath(objFSO.GetParentFolderName(strFile), objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) 27：　　　　　　Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) 28：　　　　　　Set objOpen = objFSO.OpenTextFile(strFile, 1) 29：　　　　　　Do Until objOpen.AtEndOfStream = True 30：　　　　　　　　strText = objOpen.ReadLine 31：　　　　　　　　If InStr(strText, strX) > 0 Then 32：　　　　　　　　　　objTS.WriteLine strText 33：　　　　　　　　End If 34：　　　　　　Loop 35：　　　　　　objTS.Close 36：　　　　　　Set objTS = Nothing 37：　　　　　　objOpen.Close 38：　　　　　　Set objFSO = Nothing 39：　　　　　　WScript.Sleep 1000 40：　　　　　　MsgBox ("文字列の抽出が完了しました。") 41：　　　　Else 42：　　　　　　MsgBox ("処理を中断します。") 43：　　　　End If 44：　　End If 45：　　ElseIf IsEmpty(strX) then 46：　　　　MsgBox ("キャンセルされました。") 47：　　　　WScript.Quit 48：Else 49：　　MsgBox "文字列が入力されていません。" & vbCr & "入力し直してください。", 0, "Error" 50：　　WScript.Quit 51：End If まず、４～７行目ですが、「引数が指定されていない」場合、８行目以降のプログラム処理は何をしているのでしょう？ すなわち、４行目の「If」は、このプログラム全体の「If」のおつもりではないのでしょうか？ 従って、７行目で「End If 」をしても、プログラムは下の行を実行してしまいます。 ４行目の「If」で、「引数が指定されていない」場合、７行目の「End If」でこのプログラムそのものが終了している、と勘違いされておられませんか？

  • Prome_Lin
  • ベストアンサー率42% (201/470)
回答No.2

見やすくしました。 01：Option Explicit 02：　　Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS 03：　　intCount = 0 04：☆　If WScript.Arguments.Count = 0 Then 05：　　　　WScript.Echo "引数が指定されていません。" 06：　　　　WScript.Quit 07：☆　End If 08：　　For Each strArg In WScript.Arguments 09：　　　　intCount = intCount + 1 10：　　　　strFile = strArg 11：　　Next 12：　　Set objFSO = CreateObject("Scripting.FileSystemObject") 13：★　If objFSO.GetExtensionName(strFile) <> "txt" Then 14：○　　　If intCount > 1 Then 15：　　　　　　MsgBox "2つ以上のファイルが指定されています。" & vbCr & "ファイルを指定し直してください。", 48, "Error" 16：　　　　　　WScript.Quit 17：○　　　Else 18：　　　　　　MsgBox "テキストファイル以外が指定されています。" & vbCr & "ファイルを指定し直してください。", 48, "Error" 19：　　　　　　WScript.Quit 20：○　　　End If 21：★　Else 22：　　　　strX = InputBox("抽出したい文字列を入力してください。", "変換処理") 23：●　　　If strX <> "" Then 24：　　　　　　lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr & "変換しますか？", 4 + 32 + 0, "確認") 25：◎　　　　　If lonmsgbox = 6 Then 26：　　　　　　　　strNewFile = objFSO.BuildPath(objFSO.GetParentFolderName(strFile), objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) 27：　　　　　　　　Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) 28：　　　　　　　　Set objOpen = objFSO.OpenTextFile(strFile, 1) 29：　　　　　　　　Do Until objOpen.AtEndOfStream = True 30：　　　　　　　　　　strText = objOpen.ReadLine 31：◇　　　　　　　　　If InStr(strText, strX) > 0 Then 32：　　　　　　　　　　　　objTS.WriteLine strText 33：◇　　　　　　　　　End If 34：　　　　　　　　Loop 35：　　　　　　　　objTS.Close 36：　　　　　　　　Set objTS = Nothing 37：　　　　　　　　objOpen.Close 38：　　　　　　　　Set objFSO = Nothing 39：　　　　　　　　WScript.Sleep 1000 40：　　　　　　　　MsgBox ("文字列の抽出が完了しました。") 41：◎　　　　　Else 42：　　　　　　　　MsgBox ("処理を中断します。") 43：◎　　　　　End If 44：★　End If 45：　　ElseIf IsEmpty(strX) then 46：　　　　MsgBox ("キャンセルされました。") 47：　　　　WScript.Quit 48：●　Else 49：　　　　MsgBox "文字列が入力されていません。" & vbCr & "入力し直してください。", 0, "Error" 50：　　　　WScript.Quit 51：●　End If 回答No.1の方が言われているとおり、上記の場合、「45行目」の「ElseIf」がどの「If」に対応しているのか分かりません。 なお、あまり「If」を複雑にせず（見通しが悪い）、プログラムを工夫できないでしょうか？

  • notnot
  • ベストアンサー率47% (4847/10260)
回答No.1

Elseのあとに、ElseIfが出てきちゃってますね。これが原因です。 Option Explicit Dim intCount, strFile, strArg, strX, lonMsgBox, objFSO, objOpen, strText, strNewFile, objTS intCount = 0 If WScript.Arguments.Count = 0 Then 　　WScript.Echo "引数が指定されていません。" 　　WScript.Quit End If For Each strArg In WScript.Arguments 　　intCount = intCount + 1 　　strFile = strArg Next Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.GetExtensionName(strFile) <> "txt" Then 　　If intCount > 1 Then 　　　　MsgBox "2つ以上のファイルが指定されています。" & vbCr _ 　　　　& "ファイルを指定し直してください。", 48, "Error" 　　　　WScript.Quit 　　Else 　　　　MsgBox "テキストファイル以外が指定されています。" & vbCr _ 　　　　& "ファイルを指定し直してください。", 48, "Error" 　　　　WScript.Quit 　　End If Else 　　strX = InputBox("抽出したい文字列を入力してください。", "変換処理") 　　If strX <> "" Then 　　lonmsgbox = MsgBox (strX & "を抽出します。" & vbCr _ 　　& "変換しますか？", 4 + 32 + 0, "確認") 　　If lonmsgbox = 6 Then 　　 strNewFile = objFSO.BuildPath( _ 　　　　objFSO.GetParentFolderName(strFile), _ 　　　　　　objFSO.GetBaseName(strFile) & "_New." & objFSO.GetExtensionName(strFile)) 　　　　　　Set objTS = objFSO.OpenTextFile(strNewFile, 2, True) 　　　　　　Set objOpen = objFSO.OpenTextFile(strFile, 1) 　　　　　　Do Until objOpen.AtEndOfStream = True 　　　　　　　　strText = objOpen.ReadLine 　　　　　　　　If InStr(strText, strX) > 0 Then 　　　　　　　　　　objTS.WriteLine strText 　　　　　　　　End If 　　　　　　Loop 　　　　　　objTS.Close 　　　　　　Set objTS = Nothing 　　　　　　objOpen.Close 　　　　　　Set objFSO = Nothing 　　　　　　WScript.Sleep 1000 　　　　　　MsgBox ("文字列の抽出が完了しました。") 　　　　Else 　　　　　　MsgBox ("処理を中断します。") 　　　　End If 　　End If ElseIf IsEmpty(strX) then 　　MsgBox ("キャンセルされました。") 　　WScript.Quit Else 　　MsgBox "文字列が入力されていません。" & vbCr _ 　　& "入力し直してください。", 0, "Error" 　　WScript.Quit End If

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. その他（プログラミング・開発）

関連するQ&A

  • 【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 ("文字列の抽出が完了しました。")

  • 【VBScript】文字列抽出&テキスト生成

    QNo.9089814の内容と被ってしまうのですが、 アドバイスいただければと思います。 まず以下のプログラムがあります。 現状kensyo.vbsに任意のテキストファイルをドラッグすると、 そのファイルのフルパスを表示した後、 内容を出力する処理となっています。 途中InputBoxを起動し、抽出したい文字列を入力し、 その文字列を変換します、というMsgBoxを加えています。 MsgBoxで「はい」を選択したら、読み込んだテキストファイルから 文字列が含まれる行のみ別名のテキストファイルに抽出したいと考えています。 テキストファイルを読み込む動作までは出来たのですが、 以降の処理をどうすればいいのか、行き詰ってしまいました。 恐れ入りますが、ご教示いただけますと幸いです。 ================================================== <kensyo.vbs> Option Explicit Dim intc Dim strFile, strArguments, strInput, lonmsgbox, objFSO, objOpen, strText intc = 0 If WScript.Arguments.Count = 0 Then WScript.Echo "引数が指定されていません。" Else For Each strArguments In WScript.Arguments intc = intc + 1 strFile = strArguments Next If intc > 1 Then MsgBox "2つ以上のファイルが指定されています。" & vbCr _ & "ファイルを指定し直してください。", 48, "Error" Else WScript.Echo strFile strInput = InputBox("抽出したい文字列を入力してください。") lonmsgbox = MsgBox (strInput & "を抽出しました。" & vbCr _ & strInput & "を変換しますか？", 4 + 32 + 0, "確認") If lonmsgbox = 6 Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objOpen = objFSO.OpenTextFile(strFile, 1) Do Until objOpen.AtEndOfStream = True strText = objOpen.ReadAll WScript.echo strText Loop objOpen.Close Set objFSO = Nothing Else MsgBox ("処理を中断します。") End If End If End If ==================================================

  • VBSでフォルダ、ファイル作成時のエラーコード

    フォルダ、ファイルが存在しないとき、作成するスクリプトをVBSで作成していますが、疑問点があるのでご教示ください。 objFSO.CreateFolder、objFSO.CreateTextFileを実行が、正常に行われた場合、 Err.Numberに0がセットされると思っていましたが、実際は違っていました。 objFSO.CreateFolderでフォルダが作成される場合、Err.Numberに13が返されます。 objFSO.CreateTextFileでファイルが作成される場合、Err.Numberに438が返されます。 このスクリプトを実行後、フォルダ、ファイルが存在しない場合、作成されることも確認しています。 フォルダ作成後、作成されたフォルダに対して、ファイルの作成／データの書き込みのアクセス権を拒否にすると返されるErr.numberに70がセットされることも確認しています。 なぜ、フォルダ、ファイルが作成された場合、0が返されないのかご存知の方がいらっしゃいましたらご教示ください。 また、その情報が記載されている書籍およびサイトがあれば、お教えいただければ、幸いです。 Option Explicit Dim objFSO Dim objFile Const strFolderName = "C:\VBS" Const strFileName = "C:\VBS\test.txt" On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then WScript.Echo "FSOオブジェクトを作成しました" Else WScript.Echo "FSOオブジェクトを作成できませんでした" WScript.Quit(1) End If If objFSO.FolderExists(strFolderName) Then WScript.Echo "フォルダが見つかりました" Else WScript.Echo "フォルダが見つかりませんでした" If objFSO.CreateFolder(strFolderName) Then If Err.Number = 13 Then WScript.Echo "フォルダを作成しました" Else WScript.Echo "フォルダを作成できませんでした" WScript.Quit(1) End If End If End If If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else Script.Echo "ファイルが見つかりませんでした" If objFSO.CreateTextFile(strFileName) Then If Err.number = 438 Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If End If

  • 【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

  • VBScriptでファイルからgoogle検索

    カレントディレクトリの.txtファイルを1行づつ読み込み、google検索したいのですが、ウィンドウが複数立ち上がってしまい1ウィンドウでタブで表示したいのですが上手くいきません。。と、テキストファイル名もタイトルタグで表示したいです。どなたかご存知でしたらご教授願います。以下、書きかけのソースになります。 ---------------------------------------------------------------------------------- use_ie Sub use_ie() 'Option Explicit 'On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Dim objWshShell ' WshShell オブジェクト If Err.Number = 0 Then Set objWshShell = WScript.CreateObject("WScript.Shell") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then For Each FLO In objFSO.GetFolder(objWshShell.CurrentDirectory).Files path = FLO.Path If Right(path, 4) = ".txt" Then Set objFile = objFSO.OpenTextFile(path, 1) Do While objFile.AtEndOfStream <> True Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True 'ie.Navigate "about:blank" 'ie.Document.Write "<title>path</title>" ie.Navigate "http://www.google.co.jp/" ',2048 '新規タブで開く waitIE ie ie.Document.getElementById("q").Value = objFile.ReadLine WScript.Sleep 100 ' 検索ボタンクリック ie.Document.all("btnG").Click waitIE ie strURL = "https://www.google.co.jp/" If ie.LocationURL = strURL Then ie.Quit Set ie = Nothing End If Loop objFile.Close End If Next Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing Set objWshShell = Nothing Set ie = Nothing End Sub ' IEがビジー状態の間待ちます Sub waitIE(ie) Do While ie.Busy = True Or ie.readystate <> 4 WScript.Sleep 100 Loop WScript.Sleep 1000 End Sub

  • VBScriptで検索結果をタブ表示したいです。

    カレントディレクトリの.txtファイルを1行づつgoogle検索したいのですが、ウィンドウが複数立ち上がってしまい1ウィンドウでタブで表示したいのですが上手くいきません。。と、テキストファイル名もタイトルタグで表示したいです。どなたかご存知でしたらご教授願います。以下、書きかけのソースになります。 ---------------------------------------------------------------------------------- use_ie Sub use_ie() 'Option Explicit 'On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Dim objWshShell ' WshShell オブジェクト If Err.Number = 0 Then Set objWshShell = WScript.CreateObject("WScript.Shell") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then For Each FLO In objFSO.GetFolder(objWshShell.CurrentDirectory).Files path = FLO.Path If Right(path, 4) = ".txt" Then Set objFile = objFSO.OpenTextFile(path, 1) Do While objFile.AtEndOfStream <> True Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True 'ie.Navigate "about:blank" 'ie.Document.Write "<title>path</title>" ie.Navigate "http://www.google.co.jp/" ',2048 '新規タブで開く waitIE ie ie.Document.getElementById("q").Value = objFile.ReadLine WScript.Sleep 100 ' 検索ボタンクリック ie.Document.all("btnG").Click waitIE ie strURL = "https://www.google.co.jp/" If ie.LocationURL = strURL Then ie.Quit Set ie = Nothing End If Loop objFile.Close End If Next Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing Set objWshShell = Nothing Set ie = Nothing End Sub ' IEがビジー状態の間待ちます Sub waitIE(ie) Do While ie.Busy = True Or ie.readystate <> 4 WScript.Sleep 100 Loop WScript.Sleep 1000 End Sub

  • VBScriptでのファイルコピー

    こんにちは いつもお世話になります。 現在、「ファイルの指定ダイアログ」で選択されたファイルの中身（ファイル名） と「フォルダ指定ダイアログ（参照先）」で選択されたフォルダ（サブフォルダ含む） 内のファイルの名前を比較して、一致しているファイルを「フォルダ指定ダイアログ （保存先）」にコピーし、一致しないファイル名を同じく「フォルダ指定ダイアログ （保存先）」に出力するというツールを作成しています。 以下を実行させても、ファイルのコピーも出力もされないのですが、教えていただけます でしょうか。 宜しくお願い致します。 ---------------------------------------------------------------------- <html><head> <script language="VBScript"> 'Call Window.ResizeTo(500,200) Set objFso = CreateObject("Scripting.FileSystemObject") 'テキストファイル吐き出し場所 Const LIST_FILE = "C:\Documents and Settings\All Users\デスクトップ\NonFile.txt" '色々宣言 Dim objFso Dim inFolderName Dim outFolderName Dim inFileName Dim objTxIn Dim ListFile Dim CurrentFileName '色々定数 Const TristateTrue = -1 Const TristateFalse = 0 Const TristateUseDefault = -2 Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 '参照フォルダをテキストに表示 '------------------------------------------------------------ sub inFolder() Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder( _ 0, "フォルダを選択してください", 0, "ssfDeskTop") If objFolder Is nothing Then MsgBox("フォルダを選択されませんでした。") Else pathFolder = objFolder.Items().Item().Path ifd.value = vbCr & pathFolder Set objFolder = nothing End If End sub '保存先フォルダの選択 '------------------------------------------------------------ sub outFolder() Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder( _ 0, "フォルダを選択してください", 0, "ssfDeskTop") If objFolder Is nothing Then 'MsgBox("フォルダを選択されませんでした。") Else pathFolder = objFolder.Items().Item().Path ofd.value = vbCr & pathFolder Set objFolder = nothing End If End sub '------------------------------------------------------------ Sub btn_onClick 'ファイルの有無チェック txOut="" inFileName = inFile.Value outFolderName = ofd.value If objFso.FileExists(inFileName) = True Then Set ListFile = objFso.OpenTextFile(inFileName,ForReading,false,TristateTrue) 'ファイルが無いとき Else MsgBox("ファイルが選択されていません。") End If Call iFolder(inFolderName) MsgBox("完了") End Sub 'サブフォルダ内ファイル検査→有　コピー/無　テキスト出力 '------------------------------------------------------------ Sub iFolder(inFolderName) CurrentFileName="" 'フォルダオブジェクト取得 outFolderName = ofd.value If inFolderName ="" then inFolderName = ifd.value Set fsoFolder = objFso.GetFolder(inFolderName) On Error Resume Next CurrentFileName = ListFile.ReadLine For Each fsoFile In fsoFolder.Files If fsoFile.Name = CurrentFileName Then fsoFile.Copy outFolderName,CurrentFileName,false Else set NoFile = objFso.CreateTextFile(LIST_FILE,True) NoFile.WriteLine(CurrentFileName) NoFile.Close End If fsoFile.Close Set fsoFile = Nothing Next For Each fsoSubFolder In fsoFolder.SubFolders Call iFolder(fsoSubFolder) Next End Sub </script> </head>

  • VBSでファイル作成後、書き込みできない

    ファイルが存在している場合は、ファイルをオープンして書き込み、ファイルが存在していない場合は、ファイルを作成後、オープンして書き込みを行わせたいと考えています。 しかし、ファイルが存在していないとき、ファイルは作成されるのですが、『エラー：800A0046　書き込みできません。VBScript実行時エラー』が出て、書き込みができません。モードをWritingにしても同じでした。 お手数をおかけしますが、ご教示いただけますようお願いいたします。 Option Explicit '■ オブジェクトの宣言 Dim objFSO Dim objFile '■ 定数の宣言 Const strFileName = "C:\VBS\TEST.TXT" '■ 定数の宣言 '// ファイル入出力モード(8:追加書き込み) Const ForAppending = 8 Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else WScript.Echo "ファイルが見つかりませんでした" Set objFile = objFSO.CreateTextFile(strFileName) If IsObject(objFile) Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If '// ファイルのオープン Set objFile = objFSO.OpenTextFile(strFileName,ForAppending) objFile.WriteLine "2012/12/21,100,ブレーキパッド,35000"

  • VBScript について　初心者です

    会社内でmsgファイルから添付ファイルを抽出するVBScriptを以下のコードで利用させてもらっています。ただ、同じファイル名の場合は取出すことができません。アンケート.xlsx、アンケート(2).xlsx、などという形でもれなく取出せるようにできないでしょうか？よろしくお願いいたします。 Option Explicit Dim args Dim olApp Dim i Const SaveFolderPath = "C:\Test" '添付ファイルの保存先フォルダ(※要変更) Set args = WScript.Arguments If args.Count < 1 Then MsgBox "msgファイルを当スクリプトファイルにドラッグ＆ドロップしてください。", vbExclamation + vbSystemModal WScript.Quit End If With CreateObject("Scripting.FileSystemObject") If .FolderExists(SaveFolderPath) = False Then MsgBox "添付ファイルの保存先フォルダが見つかりませんでした。" & vbCrLf & _ "処理を中止します。", vbCritical + vbSystemModal WScript.Quit End If Set olApp = CreateObject("Outlook.Application") For i = 0 To args.Count - 1 If .FileExists(args(i)) = True Then Select Case LCase(.GetExtensionName(args(i))) Case "msg" 'msgファイルのみ処理 SaveMsgAttachments olApp, args(i), AddPathSeparator(SaveFolderPath) End Select End If Next olApp.Quit End With MsgBox "処理が終了しました。", vbInformation + vbSystemModal Private Sub SaveMsgAttachments(ByVal OutlookApp, ByVal MsgFilePath, ByVal SaveFolderPath) Dim itm 'Outlook.MailItem Dim atc 'Outlook.Attachment Dim fn With OutlookApp.GetNamespace("MAPI") Set itm = .OpenSharedItem(MsgFilePath) Select Case LCase(TypeName(itm)) Case "mailitem" If itm.Attachments.Count < 1 Then MsgBox "添付ファイルがありません。" & vbCrLf & _ "(ファイル名：" & MsgFilePath & ")", vbExclamation + vbSystemModal Exit Sub Else With CreateObject("Scripting.FileSystemObject") For Each atc In itm.Attachments fn = SaveFolderPath & atc.FileName If .FileExists(fn) = True Then .DeleteFile fn, True '同名のファイルがあったら事前に削除 End If atc.SaveAsFile fn Next End With End If End Select End With End Sub Private Function AddPathSeparator(ByVal s) If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92) AddPathSeparator = s End Function

  • VBS

    VBSであるファイルを１行ずつ読み込み、その読み込んだ値を ある別のファイルにリダイレクトしたいのですが、 どのように書けばよいか教えてください。 下記のように、echoでは出すことができるのですが、 ファイルにリダイレクトというのができません。 よろしくお願いします。 ==== sample shell ========================= Option Explicit On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile("d:\dr1.txt") If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True WScript.Echo objFile.ReadLine Loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing ============================================================

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する