================================================================================ Learn More About New Technology Visual Basic Script -- Windows Scripting Host I-ichirow Suzuki ================================================================================ Visual Basic Script -- Windows Scripting Host 1. VBScriptの基礎 2. VBScript 覚えておきたいそのほかの条件分岐 3. VBScript エラー処理の基礎 4. Windows Scripting Host 5. Windows Scripting Host Sample 情報取得 6. Windows Scripting Host Sample オブジェクトの作成 7. Windows Scripting Host Sample ダイアログボックスの表示 8. Windows Scripting Host Sample インプットボックスの表示 10. Windows Scripting Host Sample レジストリの操作 11. Windows Scripting Host Sample コントロールパネルの操作 ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 1 VBScript の基礎 /////////////////////////////////////////////////////// ファイル名を ***.vbs として内容に下記1行を記述して保存後ダブルクリック ------------------------------------------------------------------------------- 'お約束のアウトプット MsgBox "Hello World!" ------------------------------------------------------------------------------- 次はこれ ------------------------------------------------------------------------------- 'シンプルすぎて役に立たないサンプル InputBox "何か入力してください。" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '多少よくなったサンプル Dim str '変数の宣言 str = InputBox ("何か入力してください。") MsgBox str ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '簡単な足し算(全角数字を入れると文字列結合されます。) Dim var1 var1 = InputBox("数字を入力してください") Dim var2 var2 = InputBox("もう1つ数字を入力してください") Dim total total = var1 + var2 MsgBox "最初の入力は:" & var1 & vbCRLF & _ "次の入力は :" & var2 & vbCRLF & _ "足すと :" & total ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '全角数字を入れても半角に変換して計算してくれます。 cLng() Dim var1 var1 = cLng(InputBox("数字を入力してください")) Dim var2 var2 = cLng(InputBox("もう1つ数字を入力してください")) Dim total total = var1 + var2 MsgBox "最初の入力は:" & var1 & vbCRLF & _ "次の入力は :" & var2 & vbCRLF & _ "足すと :" & total ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '簡単な条件分岐 Dim var var = InputBox("何か入力してください") If var = "" then Wscript.Quit '空白だったらQuitする MsgBox "入力は:" & var ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '簡単な条件分岐2 Dim var var = MsgBox("どれかのボタンを押してください", vbYesNo) If var = vbYes then MsgBox "はいが押されました" else MsgBox "いいえが押されました" End If ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '条件によって分岐する3 Dim intMsg '意図的な記述の改行は( _)半角スペースとアンダーバーの後で改行します intMsg = MsgBox ("「はい」「いいえ」「キャンセル」をクリック", _ vbYesNoCancel,"Question") If intMsg = vbYes Then MsgBox "「はい」をクリックしました",vbInformation,"Question" ElseIf intMsg = vbNo Then MsgBox "「いいえ」をクリックしました",vbInformation,"Question" Else MsgBox "「キャンセル」をクリックしました",vbInformation,"Question" End If MsgBox "終わります。",,"Question" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '条件によって分岐する4 Dim intMsg intMsg = MsgBox("時刻と日付を表示しますか?", _ vbYesNo + vbQuestion,"Question") If intMsg = vbYes Then MsgBox Time,,"時刻" MsgBox Date,,"日付" End If REM MsgBox関数の第二引数は、省略するとOKボタンだけが表示されます。 REM また、vbYesNo+vbQuestionのように、「ボタンの種類を示す数」と「表示するアイ REM コンを示す数」を足し算して指定すると、両方の効果が同時に現れます。 ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- 'いくつもの条件に対応するCase文 Dim var var = MsgBox("どれかのボタンを押してください", vbYesNoCancel) Select Case var Case vbYes MsgBox "はいが押されました" Case vbNo MsgBox "いいえが押されました" Case vbCancel MsgBox "キャンセルが押されました" End Select ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '100まで足し算し続けるのんびりスクリプト MsgBox "1から100までの総和を求めます。",vbOk+vbInformation,"Title" 'integer として認識させるための変数代入部0で初期化文字列の場合は "" とします Dim intNumber intNumber = 0 Dim I For I = 1 To 100 Step 1 intNumber = intNumber + I Next MsgBox "1から100までの総和は" & intNumber & "です。" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- 'さらにのんびりスクリプト Dim intNumber intNumber = 0 MsgBox "1から順に数字を足しあわせたとき、最初に1000を越えるのはいつでしょうか?", _ vbQuestion,"Question" Dim I For I = 1 To 100 intNumber = intNumber + I If intNumber > 1000 Then Exit For Next MsgBox "1から" & I & "までの総和は" & intNumber & "で、このときはじめて1000を越えます。" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '配列 Dim strMsg(4) ' 0,1,2,3,4,と5つの配列を準備 Dim I For I = 0 To 4 Step 1 strMsg(I) = InputBox(I + 1 & "番目の文章を入れてください。") Next MsgBox "3番目に入力した文章は「" & strMsg(2) & "」です。" ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- 'おみくじスクリプト Dim intNumber Const Title ="今日の運勢" '(1)メッセージボックスのタイトルを決める Randomize '(2)乱数を初期化 intNumber = Int( Rnd * 10 ) '(3)intNumberに0から9の数字を入れる Select Case intNumber '(4)Select Case文ここから Case 0 '(5)intNumberが0のとき MsgBox "大吉",,Title Case 1,2 '(6)intNumberが1か2のとき MsgBox "中吉",,Title Case 3,4,5 MsgBox "小吉",,Title Case 6 MsgBox "末吉",,Title Case 7,8 MsgBox "凶",,Title Case Else '(7)intNumberが他の値の時 MsgBox "大凶",,Title End Select '(8)Select Case文の終わり ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- 'おみくじスクリプト2 Dim intNumber Const Title ="今日の運勢" '(1)メッセージボックスのタイトルを決める Randomize '(2)乱数を初期化 intNumber = Int( Rnd * 10 ) '(3)intNumberに0から9の数字を入れる If intNumber=0 Then MsgBox "大吉",,Title ElseIf intNumber=1 Or intNumber=2 Then MsgBox "中吉",,Title ElseIf ..... Else MsgBox "大凶",,Title End If ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- 'Dim宣言なしではエラーになるオプション設定 Option Explicit '変数宣言なしではエラーになるようなオプション Dim num 'numと言う変数を宣言 Dim msg num = 9 msg = "Hello" num = num + 1 'numをひとつインクリメント msg = msg & num & " O'clock" '文字列結合 WScript.Echo( msg ) ------------------------------------------------------------------------------- '閏年早わかりスクリプト Dim LeapYear LeapYear = 1900 Call LeapYear(1996) Call LeapYear(1997) Call LeapYear(2000) Call LeapYear(Year(Date)) REM LeapYearプロシージャ。 REM 引数としてintYear(西暦で表示した年度)を指定すると、その年が閏年か否かを表示します Sub LeapYear(intYear) If intYear mod 4 <> 0 Or (intYear mod 100 = 0 And intYear mod 400 <> 0) Then Msgbox intYear & "年は平年です。" Else Msgbox intYear & "年は閏年です。" End If End Sub ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- '閏年早わかりスクリプト2 Dim intNumber Do intNumber = InputBox("4桁の数字を入れてください。","閏年判定",Year(Date)) If intNumber = "" Then Wscript.Quit If blnLeapYear(intNumber) Then MsgBox intNumber & "は、閏年です。" Else MsgBox intNumber & "は、平年です。" End If Loop '引数として年度を与えると、それが閏年ならTrue、平年ならFalseを返す。 Function blnLeapYear(intYear) If intYear mod 4 <> 0 Or (intYear mod 100 = 0 And intYear mod 400 <> 0) Then blnLeapYear = False Else blnLeapYear = True End If End Function ------------------------------------------------------------------------------- ############################################################################## /////////////////////////////////////////////////////////////////////////////// // 2 VBScript 覚えておきたいそのほかの条件分岐 ///////////////////////////// // Grobal Object & Local Object /////////////////////////////////////////////// Option Explicit Dim str Dim str2 str = "Hello" aisatu() Sub aisatu() str = "My name is" str2 = "Suzuki" WScript.Echo( str & str2 ) End Sub str2 = "JOKER HOE" WScript.Echo( str & str2 ) // Do while Loop ////////////////////////////////////////////////////////////// Dim num Do while num < 100 num = num * num Loop WScript.Echo( num ) // Do Loop while ////////////////////////////////////////////////////////////// Dim num Do num = num * num Loop while num < 100 WScript.Echo( num ) // Do Until Loop ////////////////////////////////////////////////////////////// Dim num Do Until num = 100 num = num + 1 Loop WScript.Echo( num ) // Do Loop Until ////////////////////////////////////////////////////////////// Dim num Do num = num + 1 Loop Until num = 100 WScript.Echo( num ) // While Wend //////////////////////////////////////////////////////////////// Dim num While num < 100 num = num * num Wend WScript.Echo( num ) // For to Next //////////////////////////////////////////////////////////////// Dim num For i = 1 to 10 Step 1 num = num + 1 Next WScript.Echo( num ) // For Each in Next /////////////////////////////////////////////////////////// For Each i in ArrayMembers WScript.Echo ( i ) Next // Exit Do //////////////////////////////////////////////////////////////////// Do While num < 100 If num = 32 Then Exit Do num = num * 2 Loop // Exit For /////////////////////////////////////////////////////////////////// For i = 1 to 10 If num = 32 Then Exit For num = num * 2 Next // If Then //////////////////////////////////////////////////////////////////// If temper > 28 Then WScript.Echo ("冷房を入れましょう") End If // If Then Else End If //////////////////////////////////////////////////////// If temper > 28 Then WScript.Echo ("冷房を入れましょう") ElseIf temper > 23 Then WScript.Echo ("ちょうどいいね") Else WScript.Echo ("さむいです") EndIf // Select Case End Select ///////////////////////////////////////////////////// Dim checkName checkName = "taro" Select Case checkName Case "taro" WScript.Echo ("Hello taro") Case "hanako" WScript.Echo ("Hello hanako") Case Else WScript.Echo ("Join Reg Member") End Select // Call /////////////////////////////////////////////////////////////////////// Dim number1, number2 number1 = 10 number2 = 20 Call calc(number1, number2) Sub calc(a, b) WScript.Echo "number1 + number2 = ", a + b End Sub // Function /////////////////////////////////////////////////////////////////// myCalc() Sub myCalc() '値を返さない関数Sub Dim a, b a = 10 b = 20 WScript.Echo "number1 + number2 = ", calc(a, b) End Sub Function calc(a, b) '値を返す関数Function calc = a + b End Function ############################################################################## /////////////////////////////////////////////////////////////////////////////// ////3 VBScript エラー処理の基礎 //////////////////////////////////////////// スクリプトを書く上で必要不可欠になるのが、今回取り上げるエラー処理です。まず は、エラーとは何かについて、 実例を挙げて説明しましょう。 -------------------------------------------- MsgBox "Test -------------------------------------------- このようなスクリプトを実行しようとすると、「Microsoft VBScript コンパイル エ ラー」と書かれたダイアログが表示され、終了してしまいます。これは、MsgBox関数の 引数が本来 "Test" となるべきなのに、 "Test のように " を付け忘れているという、 文法ミスを犯しているためです。この手のミスは結構ありがちですが、エラーメッセー ジに従って該当する行の修正をおこなえば問題ありません。 If文にEnd Ifを付け忘れるなどの構文ミス、全角のスペースを入れてしまうなど文字 の不正等に気をつける必要があります。 では、文法的にミスはないにも関わらす、エラーが発生する例を挙げます。 --------------------------------------------- Dim A Dim B Dim C MsgBox "実行時エラーの例" A = "a" B = "b" C = A * B MsgBox C ---------------------------------------------- このスクリプトは、文法的にミスはありませんが、5行目で文字型の変数Aと変数Bを かけようとしています。しかし実際は不可能なので、5行目を実行しようとした時点で 、「Microsoft VBScript 実行時エラー」と書かれたダイアログが出て終了してしまい ます。これもエラーとなる部分を直せば問題ありません。このスクリプトの場合、AとB という変数に数字を入れるか、* のかわりに & を使えばエラーは発生しません。 このような実行時エラーのうち、簡単な修正だけでは回避できない場合もあります。 ---------------------------------------------- Dim R Dim S R = InputBox ("半径を入力してください。","円の面積を求める") S = 3.14159 * R^2 MsgBox "面積は " & S ---------------------------------------------- このスクリプトは、ユーザーが入力した半径の値から、円の面積を求めるものです。 InputBox関数で、任意の半径の値が入力できますが、ここで数字以外の文字を入力す ると、3行目で文字をかけ算しようとしてエラーになってしまいます。このエラーを回 避するためには、入力された値が、数字かどうか判断するルーチンを追加しなければな りません。これにはいくつかの方法がありますが、IsNumeric関数を使うのが簡単です。 IsNumeric関数は、引数として指定した値が、数値演算可能ならTrue、そうでないならFa lseを返します。 ---------------------------------------------- Dim R Dim S R = InputBox ("半径を入力してください。","円の面積を求める" ) If IsNumeric(R) Then R = CDbl(R) S = 3.14159 * R^2 S = CStr(S) MsgBox "面積は " & S Else MsgBox "半径には数字を指定してください" End If ----------------------------------------------- このようにすると、入力された値が数字でない場合は面積を計算せず、注意を表示し て終了するようになります。 なお、CDbl関数は、引数として指定した値を倍精度浮動小数点数型にして返すもので す。InputBox 関数の返値は文字列型の値なので、演算をする際はこのように、念のた めデータ型を変換して置いた方が良いでしょう。( とくに + には、数値を足すだけで なく、文字列連結 & の意味もあるので、足し算するときはこの作業が不可欠です。) CStr関数は引数を文字列型に変換する関数です。これはあまり必要ないかもしれませ んが、念のためです。 同様の系列として、次に挙げるスクリプトも見てください。 ------------------------------------------------ Dim X Dim R X = InputBox ("数値を入力してください。","逆数を求める") If IsNumeric(X) Then X = CDbl(X) If X <> 0 Then R = 1 / X MsgBox X & "の逆数は" & R Else MsgBox "0以外の数字を指定してください" End If Else MsgBox "数字を指定してください" End If ------------------------------------------------- これは入力された数字の逆数を求めるものです。与えられた値が数字かどうかを判断 するのはもちろんですが、わり算を実行するときはこのように割る数が0でないかどう かを確認するルーチンも必要です。これを省くと、0を入力すると、「0で除算しました 」という実行時エラーが発生してしまいます。 以上で述べたように、コードに手を加えることでエラーを回避することが可能なこと が多いのですが、中にはエラーの回避が不可能、あるいは回避させるのに本筋とは関係 ない処理を長々と書かねばならないという事態も多々発生します。 このようなとき、VBSではエラーの発生を止めずに、エラーが発生してから後処理を する方法が用意されています。 それにはOn Error Resume NextステートメントおよびErrオブジェクトを利用します。 On Error Resume Nextステートメントを記述した行以降でエラーが発生しても、その エラーが発生した行で強制終了せずに、その次の行から処理を続行するようになります 。上の逆数スクリプトにOn Error Resume Nextステートメントを導入すると、こうなり ます。 ---------------------------------------------------------------- On Error Resume Next Dim X Dim R X = InputBox ("数値を入力してください。","逆数を求める") R = 1 / X MsgBox X & "の逆数は" & R ---------------------------------------------------------------- このようにすると、仮に文字や、0を入力しても、実行時エラーのダイアログは表示 されず最後まで処理が実行されるようになります。ただし、変数 R に有効な数字が代 入されないので、最後の行のMsgBoxで結果は表示されません。 エラーが発生したときは別の表示をするように改良しましょう。 ---------------------------------------------------------------- On Error Resume Next Dim X Dim R X = InputBox ("数値を入力してください。","逆数を求める") R = 1 / X Select Case Err.Number Case 0 MsgBox X & "の逆数は" & R Case 11 MsgBox "0以外の数字を指定してください",,Err.Number & ":" & Err.Description Case 13 MsgBox "数字を指定してください",,Err.Number & ":" & Err.Description End Select Err.Clear ----------------------------------------------------------------- 実行時エラーの情報は、Errオブジェクトに格納されています。Errオブジェクトの主 なプロパティには、Numberプロパティ(エラー番号)、Descriptionプロパティ(エラーの 内容)、Sourceプロパティ(エラーの発生元) があります。 エラーが発生していない状態では、 Err.Number = 0 Err.Description = "" Err.Source = "" という値を持っていますが、実行時エラーが発生すると、そのエラーに応じてErrオブ ジェクトの各プロパティの値が 変わります。なので、どんなエラーが発生したかを知るには、これらのプロパティをコ ード中から参照するといいわけです。 上のスクリプトでは、Err.Numberの値に応じて表示するメッセージを変更しています 。またメッセージボックスのタイトルには、具体的なエラーの内容を表示するようにし ています。 VBSにどんなエラーがあり、どのNumberが割り当てられているかについてはVBSランゲ ージリファレンスを参照してく ださい。 このスクリプトの最後の行では、ErrオブジェクトのClearメソッドを用いて、Errオ ブジェクトの各プロパティをエラー発生前の状態に戻しています。こうすることで、エ ラー処理が完了することになります。 (Errオブジェクトには、任意のエラーを発生させるRaiseメソッドもあります) なお、On Error Resume NextステートメントをSubプロシージャやFunctionプロシー ジャ内で記述すると、On Error Resume Nextはそのサブルーチン中でのみ有効になり、 メインルーチンでエラーが発生したときには強制終了するので注意が必要です。 さて最後に、意図的にエラーを発生させることで、コードのデバッグを容易にする方 法を紹介しましょう。 コードの最初に、Option Explicitという行を入れておくと、Dimなどで宣言されてい ない変数を使用しようとすると、実行時エラー(Number = 500)が発生してスクリプトが 実行されなくなります。こうしておくと、宣言していない変数を間違って使用すること で、スクリプトが思わぬ動作をする事を避けることができます。 ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 4 Windows Scripting Host /////////////////////////////////////////////////// WScriptオブジェクト /////////////////////////////////////////////////////////// WScriptオブジェクトのプロパティ WScript.Application WScriptオブジェクトで使用するIDispatchインターフェースを返す WScript.Arguments WshArgumentsオブジェクトを返す WScript.FullName WSH実行ファイルへの絶対パスを表す文字列を返す WScript.Interactive 対話モードとバッチモードのどちらになっているのかを0か1で返す WScript.Name WSHの登録名("WindowsScripting Host")を返す WScript.Version WSHのバージョン番号を表す WScript.Path WScript.exeまたはCScript.exeが存在する位置を表示する WScript.ScriptFullName WSHによって実行されているスクリプトファイルの絶対パスを返す WScript.ScriptName WSHによって実行されているスクリプトファイルの名前を返す WScriptオブジェクトのメソッド/////////////////////////////////////////////////////////// WScript.CreateObject(strProgID) strProgIDで指定されたオブジェクトを作成する WScript.DisconnectObject 指定されたオブジェクトをWSHから切り離す WScript.Echo 引数として指定した値がウインドウまたはコンソールウインドウに表示される WScript.GetObject(strPathName, strProgID)オブジェクトのパスを指定してオートメーションオブジェクトを取得 WScript.Quit(intErrorCode) 指定されたエラーコードでプログラムの実行を終了する ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 5 Windows Scripting Host Sample ////////////////////////////////////////// 情報取得 ====================================================================== --------------------------------------------------------------- 'WSHの登録名とバージョンを表示します Option Explicit On Error Resume Next WScript.Echo WScript.Name, "Version", WScript.Version --------------------------------------------------------------- '調べたいドライブの情報を抽出します。 Option Explicit Dim DrvPath DrvPath = inputbox("ドライブ名") If len(DrvPath) = 0 Then Wscript.Quit If len(DrvPath) <> 1 Then MsgBox "ドライブ名が不正です" Wscript.Quit End If DrvPath = Ucase(DrvPath) If DrvPath < "A" or "Z" < DrvPath then MsgBox "ドライブ名が不正です" Wscript.Quit End If Dim FS Set FS = CreateObject("scripting.FileSystemObject") Dim D Set D = FS.GetDrive(DrvPath & ":") MsgBox "ドライブ " & d.VolumeName & "(" & UCase(drvPath) & ")" & vbCrLf _ & "ドライブタイプ: " & D.DriveType & vbCRLF _ & "ファイルシステム: " & D.FileSystem & vbCRLF _ & "容量: " & FormatNumber(D.TotalSize/1024, 0, True, True, True) & " KB" & vbCRLF _ & "空き領域: " & FormatNumber(D.FreeSpace/1024, 0, True, True, True) & " KB" --------------------------------------------------------------- '各ドライブが使用可能かどうかを調べます。 Option Explicit Dim FS Set FS = CreateObject("scripting.FileSystemObject") Dim DS Set DS = FS.Drives Dim D For Each D In DS MsgBox D.DriveLetter & ": " & D.IsReady Next --------------------------------------------------------------- 'フォルダの属性を調べる Option Explicit On Error Resume Next Dim folderPath folderPath = inputbox("フォルダ名") If len(folderPath) = 0 Then Wscript.Quit Dim FS Set FS = CreateObject("scripting.FileSystemObject") Dim FL Set FL = FS.GetFolder(folderPath) If Err <> 0 Then MsgBox Err.description & "(" & Err.Number & ")" Wscript.Quit End If MsgBox "フォルダ名:" & FL.Name & vbCRLF _ & "作成日 :" & FL.DateCreated & vbCRLF _ & "更新日 :" & FL.DateLastModified & vbCRLF _ & "サイズ :" & FL.Size & vbCRLF _ & "属性 :" & FL.Attributes If FL.Attributes And 4 Then MsgBox "システムファイルです" If FL.Attributes And 0 Then MsgBox "標準ファイル " If FL.Attributes And 1 Then MsgBox "読み取り専用ファイル " If FL.Attributes And 2 Then MsgBox "隠しファイル " If FL.Attributes And 4 Then MsgBox "システム ファイル " If FL.Attributes And 8 Then MsgBox "ディスク ドライブ ボリューム ラベル " If FL.Attributes And 16 Then MsgBox "フォルダまたはディレクトリ " If FL.Attributes And 32 Then MsgBox "アーカイブ(バックアップ処理などで使用します) " If FL.Attributes And 64 Then MsgBox "リンクまたはショートカット" If FL.Attributes And 128 Then MsgBox "圧縮ファイル" --------------------------------------------------------------- 'フォルダの一覧を見る option Explicit On Error Resume Next Dim folderPath folderPath = inputbox("フォルダ名") If len(folderPath) = 0 Then Wscript.Quit Dim fs Set fs = CreateObject("scripting.FileSystemObject") Dim fl Set fl = fs.GetFolder(folderPath) If Err <> 0 Then MsgBox Err.description & "(" & Err.Number & ")" Wscript.Quit End If Dim fc Set fc = fl.SubFolders Dim sf For Each sf In fc MsgBox "サブフォルダ名:" & sf.Name & vbCRLF _ & "作成日 :" & fl.DateCreated & vbCRLF _ & "更新日 :" & fl.DateLastModified & vbCRLF _ & "サイズ :" & fl.Size & vbCRLF _ & "属性 :" & fl.Attributes Next ---------------------------------------------------------------- 'C:\Windows\tips.txtのファイル属性を調べる Option Explicit On Error Resume Next Dim Fs Dim info Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル名を決めます。 Const filename="C:\Windows\tips.txt" If Fs.FileExists(filename) = False Then 'FileExistsメソッド。引数が存在するファイル名ならTrue、存在しないとFalseを返す。 MsgBox filename & "というファイルは存在しません。" WScript.Quit End If info="ファイル名=" & Fs.GetFileName(filename) & vbCrLf & _ "フルパス=" & Fs.GetAbsolutePathName(filename) & vbCrLf & _ "親フォルダ名=" & Fs.GetParentFolderName(filename) & vbCrLf & _ "ドライブ名=" & Fs.GetDriveName(filename) & vbCrLf & _ "拡張子=" & Fs.GetExtensionName(filename) & vbCrLf & _ "拡張子を除いた名前=" & Fs.GetBaseName(filename) MsgBox info --------------------------------------------------------------- 'ファイルの一覧とファイルの情報を見る Option Explicit On Error Resume Next Dim folderPath folderPath = inputbox("フォルダ名") If len(folderPath) = 0 Then Wscript.Quit Dim fs Set fs = CreateObject("scripting.FileSystemObject") Dim fl Set fl = fs.GetFolder(folderPath) If Err <> 0 Then MsgBox Err.description & "(" & Err.Number & ")" Wscript.Quit End If Dim fc Set fc = fl.Files Dim f For Each f In fc MsgBox "ファイル名:" & f.Name & vbCRLF _ & "作成日 :" & f.DateCreated & vbCRLF _ & "更新日 :" & f.DateLastModified & vbCRLF _ & "サイズ :" & f.Size & vbCRLF _ & "属性 :" & f.Attributes Next -------------------------------------------------------------- 'マシン名、ユーザー名を表示 Option Explicit On Error Resume Next Dim WshNetwork Set WshNetwork = Wscript.CreateObject("Wscript.Network") WScript.Echo "マシン名", WshNetwork.ComputerName WScript.Echo "ユーザー名", WshNetwork.UserName -------------------------------------------------------------- 'リモートプリンタをローカルリソースへ割り当てる Option Explicit On Error Resume Next Dim WshNetwork Set WshNetwork = Wscript.CreateObject("Wscript.Network") WshNetwork.AddPrinterConnection "LPT1", "\\HOE\Printer" --------------------------------------------------------------- 'ネットワークプリンタのポートの割り当てを表示 Option Explicit On Error Resume Next Dim WshNetWork Set WshNetwork = WScript.CreateObject("WScript.Network") Dim objDrives Set objDrives = WshNetwork.EnumPrinterConnections WScript.Echo objDrives.Item(0) WScript.Echo objDrives.Item(1) --------------------------------------------------------------- 'コンピュータのユーザー名やドメインの取得 Option Explicit On Error Resume Next Dim WshNetwork Set WshNetwork = WScript.CreateObject("WScript.Network") Dim str str = "コンピュータ名=" & WSHNetwork.ComputerName & vbCrLf str = str & "ユーザー ドメイン名=" & WSHNetwork.UserDomain & vbCrLf str = str & "ユーザー名=" & WSHNetwork.UserName MsgBox str --------------------------------------------------------------- 'ユーザー環境設定の取得 Option Explicit On Error Resume Next Dim str '各種定数の指定 Const strDrive="Z:" 'ドライブ名 Const strShare="\\Server\Share" '共有ポイント Const strPort="LPT1" 'ローカルのプリンタポート Const strPrinter="\\Server\Print1" 'プリンタ名 Const strUserName="UserName" 'ユーザー名 Const strPassword="Password" 'パスワード Dim WSHNetwork Set WSHNetwork = WScript.CreateObject("WScript.Network") 'WshNetworkオブジェクト作成 WSHNetwork.MapNetworkDrive strDrive,strShare,False,strUserName,strPassword 'MapNetworkDriveメソッド 'ネットワークドライブを接続する。 '第一引数=接続するドライブ名 '第二引数=共有ポイント '第三引数=マップ情報をユーザープロファイルに保存するか否か(省略可) '第四引数=カレント ユーザー以外のユーザーのクレデンシャルを使用して共有ポイントをマップする場合 ' 指定するユーザー名(省略可) '第五引数=そのパスワード(省略可) MsgBox strDrive & "をネットワークドライブに割り当てました。" Dim objDrives Set objDrives=WSHNetwork.EnumNetworkDrives 'EnumNetworkDrivesメソッド 'ネットワークドライブの情報を格納した、WshCollectionオブジェクトを返す。 str="" For I=0 To objDrives.Count-1 Step 2 'Countプロパティには、要素の総数が格納されている。 str=str & objDrives.Item(I) & " " & objDrives.Item(I+1) & vbCrLf 'ネットワークドライブを格納したWSHCollectionのItemプロパティ(既定)は、 '偶数引数にドライブ名、奇数引数に共有名が格納されている。 Next MsgBox str,,"ネットワークドライブのマップ状況" WSHNetwork.RemoveNetworkDrive strDrive,False,False 'RemoveNetworkDriveメソッド 'ネットワークドライブを切断 '第一引数=切断するドライブ名 '第二引数=リソースが使用されていても切断するかどうか(省略可) '第三引数=マップ情報をユーザープロファイルに保存するか否か(省略可) 'ローカルのドライブ名がマップされていない場合は、NET USEコマンドを併用して '共有ポイント名を第一引数に指定できます。 MsgBox strDrive & "を切断しました。" WSHNetwork.AddPrinterConnection strPort,strPrinter,False,strUserName,strPassword 'AddPrinterConnectionメソッド 'ネットワークプリンタを接続する。 '第一引数=接続するポート '第二引数=プリンタ名 '第三引数=マップ情報をユーザープロファイルに保存するか否か(省略可) '第四引数=カレント ユーザー以外のユーザーのクレデンシャルを使用してプリンタをマップする場合 ' 指定するユーザー名(省略可) '第五引数=そのパスワード(省略可) WSHNetwork.SetDefaultPrinter strPrinter 'SetDefaultPrinterメソッド 'デフォルトプリンタを設定 '第一引数=プリンタ名(ポート名は指定できない) MsgBox strPort & "にネットワークプリンタを割り当てました。" Dim objPrinters Set objPrinters=WSHNetwork.EnumPrinterConnections 'EnumPrinterConnectionsメソッド 'ネットワークプリンタの情報を格納した、WshCollectionオブジェクトを返す。 str="" For I=0 To objPrinters.Count-1 Step 2 str=str & objPrinters.Item(I) & " " & objPrinters.Item(I+1) & vbCrLf Next MsgBox str,,"ネットワークプリンタのマップ状況" WSHNetwork.RemovePrinterConnection strPort,False,False 'RemovePrinterConnectionメソッド 'ネットワークプリンタを切断 '第一引数=切断するポート名 '第二引数=リソースが使用されていても切断するかどうか(省略可) '第三引数=マップ情報をユーザープロファイルに保存するか否か(省略可) 'ローカルのポート名がマップされていない場合は、NET USEコマンドを併用して 'プリンタ名を第一引数に指定できます。 MsgBox strPort & "を切断しました。" --------------------------------------------------------------- '環境変数を取得 Option Explicit On Error Resume Next Dim WSHShell Set WshShell = WScript.CreateObject("WScript.Shell") Dim WshEnv Set WshEnv = WshShell.Environment("Process") WScript.Echo WshEnv("WINDIR") --------------------------------------------------------------- 'Windowsのインストールパスを取得 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim WSHEnv '1.WshEnvironmentオブジェクトを作成 Set WSHEnv = WshShell.Environment MsgBox "Windowsインストールフォルダは、" & WSHEnv.Item("winbootdir") & "です。" '2.Windowsがインストールされているフォルダ名を表示 MsgBox "環境変数の総数は、" & WSHEnv.Count & "です。" Dim strList '3.環境変数の総数を表示 strList = "環境変数一覧は以下の通りです。" & vbCrLf '4.すべての環境変数を列挙 Dim strEnv For Each strEnv In WSHEnv strList=strList & strEnv & vbCrLf Next MsgBox strList --------------------------------------------------------------- '特殊フォルダへのアクセス Option Explicit On Error Resume Next Dim WshShell Set WshShell = WScript.CreateObject("WScript.Shell") WScript.Echo WshShell.SpecialFolders("Templates") --------------------------------------------------------------- '特殊フォルダへのアクセスとパスの取得 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim WSHSfolder Set WSHSfolder = WSHShell.SpecialFolders '1.WshSpecialFoldersオブジェクトを作成 MsgBox "デスクトップフォルダは" & WSHSfolder.Item("Desktop") Dim strFolder Dim strList '2.デスクトップのフォルダ名を取得 For Each strFolder In WSHSfolder '3.すべての特殊フォルダのパスを取得 strList=strList & strFolder & vbCrLf Next MsgBox strList --------------------------------------------------------------- ファイル・フォルダ・ドライブの情報を取得するもの BuildPath メソッド パスに新しくフォルダ名・ファイル名を付け足す DriveExists メソッド ドライブが存在するかどうか FileExists メソッド ファイルが存在するかどうか FolderExists メソッド フォルダが存在するかどうか GetAbsolutePathName メソッド フルパスを返す GetBaseName メソッド 拡張子を除いたファイルの名前を返す GetDriveName メソッド ファイルの存在するドライブ名を返す GetExtensionName メソッド 拡張子名を返す GetFileName メソッド ファイル名を返す GetParentFolderName メソッド 親フォルダ名を返す GetTempName メソッド テンポラリなファイル名(.tmp)を生成 ファイル・フォルダを操作(コピー・削除など)をおこなうもの CopyFile メソッド ファイルをコピー CopyFolder メソッド フォルダをコピー CreateFolder メソッド フォルダを作成 CreateTextFile メソッド テキストファイル作成 DeleteFile メソッド ファイルを消去 DeleteFolder メソッド フォルダを消去 MoveFile メソッド ファイルを移動 MoveFolder メソッド フォルダを移動 ファイル・フォルダ・ドライブをオブジェクトとして取得するもの CreateFolder メソッド フォルダを作成し、Folderオブジェクトを返す GetDrive メソッド Driveオブジェクトを返す GetFile メソッド Fileオブジェクトを返す GetFolder メソッド Folderオブジェクトを返す GetSpecialFolder メソッド 特別なフォルダのFolderオブジェクトを返す Drives プロパティ Drivesコレクションを返す ---------------------------------------------------------------- ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 6 Windows Scripting Host Sample ////////////////////////////////////////// オブジェクトの作成 ================================================= Option Explicit On Error Resume Next Dim WshShell Set WshShell = CreateObject("WScript.Shell") ---------------------------------------------------------------- 'テキストファイルを開く例 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.Run "tips.txt" 'ウィンドウの最大化・最小化などを指定することもできます。 'また、起動したアプリの終了を待ってから次の動作を実行させることも可能です。 ---------------------------------------------------------------- 'メモ帳を実行する例 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.Run "C:\Windows\notepad.exe" ' ファイルを関連づけにしたがって実行することもできます。 'パスの通ったフォルダにあるファイルなら、フォルダを省略して記述できます。 ---------------------------------------------------------------- 'メモ帳のショートカットアイコンを作成 Option Explicit On Error Resume Next Dim WSHShell Set WshShell = WScript.CreateObject("WScript.Shell") Dim myShortcut Set myShortcut = WshShell.CreateShortcut("メモ帳のショートカット.lnk") myShortcut.TargetPath = "notepad" myShortcut.IconLocation = "notepad.exe, 0" myShortcut.Save() --------------------------------------------------------------- 'デスクトップにエクスプローラのショートカットを作成する。 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim objSc Set objSc = WSHShell.CreateShortcut("C:\WINDOWS\デスクトップ\エクスプローラ.lnk") With objSc 'objScの各プロパティを設定。WithステートメントはVBS5.0以上で使用可。 .TargetPath="C:\Windows\explorer.exe" 'リンク先のパス。 .Arguments="/n,/root,C:\" 'コマンドラインオプション。 .HotKey="Ctrl+Alt+A" 'ホットキー .WindowStyle=3 '最大化表示 .WorkingDirectory="C:\Windows" '作業フォルダ .IconLocation="C:\Windows\System\Shell32.dll,45" 'アイコン .Save '変更点を保存。 End With --------------------------------------------------------------- '実行したスクリプト自身のショートカットをスタートメニューに登録しちゃう、迷惑な?スクリプトです。 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim objSc Set objSc = WSHShell.CreateShortcut("C:\WINDOWS\スタート メニュー\プログラム\" & Wscript.ScriptName & ".lnk") objSc.TargetPath = Wscript.ScriptFullName objSc.Save --------------------------------------------------------------- 'Webのショートカットアイコンを作成 Option Explicit On Error Resume Next Dim WSHShell Set WshShell = WScript.CreateObject("WScript.Shell") Dim myShortcut Set myShortcut = WshShell.CreateShortcut("Internet StartPages.URL") myShortcut.TargetPath = "http://www.kg-group.com/" myShortcut.Save() --------------------------------------------------------------- Dim WSHShell Set WSHShell = Wscript.CreateObject("Wscript.Shell") Set objSc = WSHShell.CreateShortcut("C:\shortcut.lnk") --------------------------------------------------------------- 'インターネットショートカットを「お気に入り」に登録してしまうという大それた?スクリプト Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim objSc Set objSc = WSHShell.CreateShortcut("C:\WINDOWS\Favorites\InternetStartPages.url") objSc.TargetPath="http://www.kg-group.com/" objSc.Save --------------------------------------------------------------- ’アプリケーションの起動 Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") REM メモ帳を起動します。 WSHShell.Run "notepad.exe" MsgBox "メモ帳を起動しました。" REM Tips.txtを関連づけに従って最大化表示 WSHShell.Run "C:\Windows\tips.txt",3,True REM 実行したスクリプト自体をメモ帳で表示 WSHShell.Run "notepad.exe " & Wscript.ScriptFullName,1,True WSHShell.Popup "実験終わり",3,"ポップアップメッセージ",vbInformation --------------------------------------------------------------- '新規フォルダと新規ファイルの作成 Dim FS Set FS = CreateObject("Scripting.FileSystemObject") On Error Resume Next FS.CreateFolder("C:\new") FS.CreateTextFile("C:\new\test.txt") --------------------------------------------------------------- '新規フォルダと新規ファイルの作成 応用 Dim FilePath FilePath = "C:\TextFile" Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim FileName FileName = FilePath & "\" & Left(Date, 2) & Mid(Date,4,2) & Right(Date,2) & ".txt" Dim newFile Set newFile = FS.CreateTextFile(FileName, True) Dim NewText newText = Month(Date) & "月" & Day(Date) & "日 記録者 :" newFile.WriteLine(newText) newFile.Close --------------------------------------------------------------- '新規フォルダと新規ファイルの作成 応用編 On Error Resume Next ' 作業内容を入力したデータを格納 Dim newText newText = InputBox("作業内容を入力して下さい") If newText = "" Then WScript.Quit 'FileSystemObjectを作成 Dim FS Set FS = CreateObject("Scripting.FileSystemObject") 'ファイルに記入する内容 Dim newFile '新規フォルダのフルパスとフォルダ名 Dim newFolder newFolder = InputBox("新規フォルダのフルパスとフォルダ名を入力して下さい","フォルダ作成","C:\NewFolder") FS.CreateFolder(newFolder) 'フルパスのファイル名 Dim FileName FileName = InputBox("ファイル名を入力して下さい","ファイル名の作成","FileName.txt") FileName = newFolder & "\" & FileName FS.CreateTextFile(FileName) ' 8は内容の一番最後の行に追加する引数 Set newFile = FS.OpenTextFile(FileName, 8) newText = Right(Time, Len(Time)-3) & " --> " & newText newFile.WriteLine(newText) newFile.Close --------------------------------------------------------------- ' フォルダとサブフォルダを作成する Option Explicit On Error Resume Next Dim folderPath '--- フォルダを作る folderPath = inputbox("フォルダ名") If len(folderPath) = 0 Then Wscript.Quit Dim fs Set fs = CreateObject("scripting.FileSystemObject") fs.CreateFolder(folderPath) If Err <> 0 Then MsgBox Err.description & "(" & Err.Number & ")" Wscript.Quit End If Dim subfolderPath '--- サブフォルダを作る subfolderPath = inputbox("サブフォルダ名") If len(subfolderPath) = 0 Then Wscript.Quit Set fs = CreateObject("scripting.FileSystemObject") fs.CreateFolder(folderPath & "\" & subfolderPath) If Err <> 0 Then MsgBox Err.description & "(" & Err.Number & ")" Wscript.Quit End If --------------------------------------------------------------- 'ファイルの新規作成とファイルへの書き込み Option Explicit On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim File_name File_name = InputBox("ファイル名を入力してください","入力","ここに入力") Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim myFile set myFile = FS.CreateTextFile(File_name, True) myFile.Write "最初の書き込み!" myFile.WriteLine "次の書き込み!" 'WriteLineで改行 myFile.Write "もうひとつ書き込み!" myFile.Close --------------------------------------------------------------- 'テキストファイルに追加で書きこむ '今までは、実行する度に新しいファイルを作っていましたが作業のログのように 'ファイルにどんどん追加する処理を説明します。 Option Explicit On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim File_name File_name = InputBox("ファイル名を入力してください") Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim myFile 'ForAppending 前の記述に追加するモード Set myFile = FS.OpenTextFile(File_name,ForAppending) myFile.Write "再度、書き込み!2" myFile.WriteLine "再度、次の書き込み!2" myFile.Write "最後の書き込み!2" myFile.Close --------------------------------------------------------------- 'ファイルの読み込み Option Explicit On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim File_name File_name = InputBox("ファイル名を入力してください","ファイル読み込み","ここに入力") Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim myFile Set myFile = FS.OpenTextFile(File_name, ForReading) Dim var var = myFile.Read(5) '5文字目までを読み込み msgbox "<" & var & ">を読み込みました" var = myFile.ReadLine '一行を読み込み msgbox "<" & var & ">を読み込みました" var = myFile.ReadAll '全文を読み込み msgbox "<" & var & ">を読み込みました" myFile.Close --------------------------------------------------------------- 'ファイルの文字と行数などを調べます。 Option Explicit On Error Resume Next Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim File_name File_name = InputBox("ファイル名を入力してください","ファイル読み込み","ここに入力") Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim myFile Set myFile = FS.OpenTextFile(File_name, ForReading) Dim var Do While myFile.AtEndOfLine <> True var = myFile.Read(1) MsgBox "var = [" & var & "] Line = [" & myFile.Line & "] Column = [" & myFile.Column & "]" Loop Do While myFile.AtEndOfStream <> True var = myFile.ReadLine MsgBox "var = [" & var & "] Line = [" & myFile.Line & "] Column = [" & myfile.Column & "]" Loop myFile.Close ---------------------------------------------------------------- 'フォルダを新しく作成してランダムなファイル名をつけて保存する Option Explicit On Error Resume Next Dim Fs Set Fs = WScript.CreateObject("Scripting.FileSystemObject") Const foldername="C:\Windows" 'フォルダを作成するフォルダを指定 Const newfoldername="新しいフォルダ" '新しく作成するフォルダ名 Dim folderpath '1.新しく作成するフォルダのフルパスを得る folderpath=Fs.BuildPath(foldername,newfoldername) '2.もしフォルダが既存なら終了 If Fs.FolderExists(folderpath) Then MsgBox "すでに同名のフォルダが存在しています。" WScript.Quit End If '3.フォルダを作成 Fs.CreateFolder folderpath MsgBox folderpath & "を作成しました。" Dim filepath '4.適当な名前のファイル名を得る filepath = Fs.BuildPath(folderpath,Fs.GetTempName) '5.新しく作ったフォルダに、0バイトのテキストファイルを作成 Fs.CreateTextFile filepath MsgBox filepath & "を作成しました。" ---------------------------------------------------------------- 'デスクトップのショートカットをコピーしてスタートメニューにデスクトップというフォルダを作成して 'その中にコピーする Option Explicit On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim Fs Set Fs = WScript.CreateObject("Scripting.FileSystemObject") Dim source '1.デスクトップにあるショートカットを指定 source = Fs.BuildPath(WSHShell.SpecialFolders("Desktop"),"*.lnk") Dim target '2.ショートカットをコピーする、スタートメニュー内のフォルダを指定 target = Fs.BuildPath(WSHShell.SpecialFolders("StartMenu"),"デスクトップ\") Dim msg msg = MsgBox ("今から" & source & "を" & target & "にコピーします。いいですか?",vbYesNo) If msg = vbNo Then Wscript.Quit '「いいえ」と答えたら終了 '3.もしフォルダがなければ作成する If Fs.FolderExists(target) = False Then Fs.CreateFolder target End If Fs.CopyFile source,target ---------------------------------------------------------------- 'C:\Windows\AppdataのなかのOEのデータをC:\backupにバックアップする Option Explicit On Error Resume Next Dim Fs Set Fs = WScript.CreateObject("Scripting.FileSystemObject") Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim source source = Fs.BuildPath(WSHShell.SpecialFolders("AppData"),"Microsoft\Outlook Express\*") Dim target target= "C:\backup" 'バックアップ先を指定 Dim msg msg=MsgBox ("今から" & source & "を" & target & "にコピーします。いいですか?",vbYesNo) If msg = vbNo Then Wscript.Quit '「いいえ」と答えたら終了 If Fs.FolderExists(target) = False Then 'もしフォルダがなければ作成する Fs.CreateFolder target Else 'ある場合は、フォルダを削除してから作成する msg = MsgBox (target & "フォルダの内容は削除されます!よろしいですか?",vbYesNo) If msg = vbNo Then Wscript.Quit '「いいえ」と答えたら終了 Fs.DeleteFolder target Fs.CreateFolder target End If 'フォルダをコピー Fs.CopyFolder source,Fs.BuildPath(target,"\") MsgBox "処理が終了しました。" ---------------------------------------------------------------- '最近使ったファイルを削除する Option Explicit On Error Resume Next Dim Fs Set Fs = WScript.CreateObject("Scripting.FileSystemObject") Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim file 'recentフォルダの場所を取得 file = Fs.BuildPath(WSHShell.SpecialFolders("Recent"),"*.*") Dim msg msg = MsgBox (file & "を削除します。いいですか?",vbYesNo) If msg = vbNo Then Wscript.Quit '「いいえ」と答えたら終了 'ファイルを削除 Fs.DeleteFile file ---------------------------------------------------------------- '文字列の置換 Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim myFolder ' 保存するフォルダのフルパスとフォルダ名 myFolder = InputBox("保存するフォルダのフルパスとフォルダ名を入力して下さい","置換","C:\NewFolder") Dim myFile '置換するファイル名 myFile = InputBox("置換するファイル名を入力して下さい","置換","BeforeText.txt") myFile = myFolder & "\" & myFile Dim Before_Word '置換する単語 Before_Word = InputBox("置換する文字列を入力して下さい","置換","") Dim After_Word '置換後の単語 After_Word = InputBox("置換後の文字列を入力して下さい","置換","") Dim myText ' 本文を読み込み格納する Set myFile = FS.OpenTextFile(myFile) myText = myFile.ReadAll myText = Replace(myText, Before_word, After_word) Dim newFile ' 置換したファイルの保存ファイル名 newFile = InputBox("置換したファイルを保存します","置換","AfterText.txt") newFile = myFolder & "\" & newFile Set newFile = FS.CreateTextFile(newFile) newFile.Write(myText) newFile.Close WScript.Echo "置換が終了しました" ---------------------------------------------------------------- 'フォルダとファイル操作 On Error Resume Next Dim myFolder myFolder = InputBox("ファイル表示させたいフォルダのパスを入力して下さい","ファイル検索","C:\My Documents") Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim objFolder Set objFolder = FS.GetFolder(myFolder) Call showFile(objFolder) Sub showFile(objFolder) For Each objFile In objFolder.Files WScript.Echo objFile Next For Each objSubFolder In objFolder.SubFolders Call showFile(objSubFolder) Next End Sub ---------------------------------------------------------------- 'ファイルの拡張子(ファイル名)の一括変換 On Error Resumu Next Dim myFolder myFolder = InputBox("フォルダを指定","ファイル名変換","C:\") If myFolder = "" Then WScript.Quit Dim beforeStr beforeStr = InputBox("置き換える文字列","ファイル名変換","ここに入力して下さい") If beforeStr = "" Then WScript.Quit Dim afterStr afterStr = InputBox("置換後の文字列","ファイル名変換","ここに入力して下さい") If afterStr = "" Then WScript.Quit Dim FS Set FS = CreateObject("Scripting.FileSystemObject") Dim objFolder Set objFolder = FS.GetFolder(myFolder) Dim myFile Call ReName(objFolder) Sub ReName(objFolder) For Each myFile In objFolder.Files If InStr(myFile.Name, beforeStr) <> 0 Then myFile.Name = Replace(myFile.Name, beforeStr, afterStr) End If Next For Each objSubFolder In objFolder.SubFolders Call ReName(objSubFolder) Next End Sub WScript.Echo beforeStr & "を" & afterStr & "に変換しました" ---------------------------------------------------------------- 'フォルダ内のテキストの一括変換 Option Explicit On Error Resume Next Dim myFolder myFolder = InputBox("フォルダを指定","置換","C:\") If myFolder = "" Then WScript.Quit Dim newFolder newFolder = InputBox("出力先のフォルダを指定","置換","C:\new") If newFolder = "" Then WScript.Quit Dim beforeStr beforeStr = InputBox("置き換える文字列","置換","ここに入力") If beforeStr = "" Then WScript.Quit Dim afterStr afterStr = InputBox("置換後の文字列","置換","ここに入力") If afterStr = "" Then WScript.Quit Dim FS Set FS = CreateObject("Scripting.FileSystemObject") FS.CopyFolder myFolder, newFolder Dim objFolder Set objFolder = FS.GetFolder(newFolder) Dim myType myType = InputBox("変換するファイルの拡張子を入力","置換","txt") If myType = "" Then WScript.Quit Call RepStr(objFolder) Sub RepStr(objFolder) Dim myFile For Each myFile In objFolder.Files If Right(myFile, 3) = myType Then Dim myText Set myText = FS.OpenTextFile(myFile) myText = myText.ReadAll Dim tmpText tmpTxt = Replace(myText,beforeStr,afterStr) Set myText = FS.CreateTextFile(objFolder & "\" & myFile.Name) myText.Write(tmpText) End If Next Dim objSubFolder For Each objSubFolder In objFolder.SubFolders Call RepStr(objSubFolder) Next End Sub WScript.Echo beforeStr & "を" & afterStr & "に置換して" & newFolder & "にコピーしました" ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 7 Windows Scripting Host Sample ////////////////////////////////////////// ダイアログボックスの表示 ====================================================== Option Explicit On Error Resume Next Dim WshShell DIm PopRt Set WshShell = WScript.CreateObject("WScript.Shell") PopRt = WshShell.Popup("ボタンを押して下さい", 0, "テスト", 1 + 32) If PopRt = 1 Then WScript.Echo "OK ボタンが押されました" Else WScript.Echo "Cancel ボタンが押されました" End If ---------------------------------------------------------------- ' MsgBoxを利用したダイアログ Option Explicit On Error Resume Next Dim MsgRt MsgRt = MsgBox("ボタンを押して下さい",vbOkCancel + vbInformation, "テスト") If MsgRt = 1 Then WScript.Echo "OK ボタンが押されました" Else WScript.Echo "Cancel ボタンが押されました" End If //////////////////////////////////////////////////////////////////////////// // 8 Windows Scripting Host Sample ////////////////////////////////////////// インプットボックスの表示 ====================================================== Dim InText inText = InputBox("文字列を入力して下さい","テスト","ここに入力して下さい") WScript.Echo inText ---------------------------------------------------------------- 'インプットボックスによるショートカットの作成 Dim WshShell 'WshShellを作成 Set WshShell = WScript.CreateObject("WScript.Shell") Dim MsgRt 'MsgBoxの値を格納 MsgRt = MsgBox("Step 1 SendtoにEditorのショートカットを作成します",4+32,"Step 1 Editorショートカットの作成") If MsgRt = 6 Then Dim ShortcutName ShortcutName = InputBox("ショートカットアイコンのファイル名を入力してください", _ "Step 1 Editorショートカットの作成","Editor.lnk") Dim AppPath AppPath = InputBox("アプリケーションのパスを指定して下さい", _ "Step 1 Notepadショートカットの作成","C:\Windows\notepad") Dim IconPathIndex IconPathIndex = InputBox("アイコンのパスとそのインデックスを指定して下さい", _ "Step 1 Notepadショートカットの作成","C:\Windows\notepad.exe, 0") 'デスクトップへのパスを格納 Dim myDesktop 'ショートカットアイコン保存のパスと名前 Dim myShortcut 'Desktopのパスを取得 myDesktop = WshShell.SpecialFolders("Desktop") mySendto = WshShell.SpecialFolders("Sendto") SaveLocationPath = mySendto 'パスとファイル名の文字列結合 Set myShortcut = WshShell.CreateShortcut(SaveLocationPath & "\"& ShortcutName & ".lnk") '起動するアプリケーションの指定 myShortcut.TargetPath = AppPath 'アイコンの保存ファイル名とインデックス番号の指定 myShortcut.IconLocation = IconPathIndex 'ショートカットを保存します myShortcut.Save End If ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 9 Windows Scripting Host Sample ////////////////////////////////////////// レジストリの操作 ========================================================== 'レジストリの参照 Dim WSHShell Set WshShell = Wscript.CreateObject("WScript.Shell") WScript.Echo WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\ProductId") RegDelete 指定したキーまたは値をレジストリから削除する RegRead 指定したキーまたは値をレジストリから取得する RegWrite 指定したキーまたは値をレジストリに書き込む --------------------------------------------------------------- '登録情報変更スクリプト Dim WSHShell Set WSHShell=Wscript.CreateObject("Wscript.Shell") Call RegChange ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RegisteredOwner", _ "ユーザー名を入力してください") Call RegChange ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RegisteredOrganization", _ "会社名を入力してください") Sub RegChange(strName,strMsg) Dim Value Value = InputBox (strMsg, "登録変更", WSHShell.RegRead (strName)) If Value <> "" Then WSHShell.RegWrite strName,Value,"REG_SZ" End If End Sub --------------------------------------------------------------- ' レジストリの編集 Dim RKey Dim Msg RKey = InputBox("拡張子を .***の形式で入力して下さい","拡張子の確認", ".txt") On Error Resume Next If RKey = "" Then MsgBox "拡張子を.***の形式で入力して下さい", 1+48, "拡張子の確認" Msg = "レジストリキーが存在しません" Msg = WshShell.RegRead("HKEY_CLASSES_ROOT\" & RKey & "\") WScript.Echo Msg End If ---------------------------------------------------------------- 'ネットワークプリンタの割り当て Dim Network_printer MsgRt = MsgBox("Step 1 ネットワークプリンタを割り当てますか?",4+32,"Step 1 ネットワークプリンタの割り当て") If MsgRt = 6 Then Network_printer = InputBox("ネットワークプリンタのパスを入力してください","ネットワークプリンタの割り当て","\\FMV-1\Epson") WshNetwork.AddPrinterConnection "LPT1", Network_printer MsgBox "ネットワークプリンタのパスを" & Network_printer & "に変更しました",4+68,"Step 1 ネットワークプリンタの割り当て" End If ---------------------------------------------------------------- 'ごみ箱アイコンの名前変更 Dim Recycled_name 'ごみ箱アイコンの名前格納 MsgRt = MsgBox("Step 2 ごみ箱の名前を変更しますか?",4+32,"Step 2 ごみ箱アイコンの名前変更") On Error Resume Next If MsgRt = 6 Then Recycled_name = InputBox("ごみ箱の名前を入れてください", "Step 2 ごみ箱アイコンの名前変更", "Recycled") WshShell.RegWrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\", Recycled_name MsgBox "ごみ箱の名前を " & Recycled_name & "に変更しました",4+68,"Step 2 ごみ箱アイコンの名前変更" End If ---------------------------------------------------------------- 'アニメーション表示のOFF MsgRt = MsgBox("Step 3 ウインドウのアニメーション表示をOFFにしますか?",4+32,"Step3 ウインドウのアニメーション表示") On Error Resume Next If MsgRt = 6 Then WshShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\MinAnimate", 0 MsgBox "ウインドウアニメーションをOFFにしました",4+68,"Step 3 ウインドウのアニメーション表示設定" Else WshShell.RegDelete "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\MinAnimate" End If ---------------------------------------------------------------- 'ビットマップデータのアイコン表示 MsgRt = MsgBox("Step 4 ビットマップデータをアイコン表示しますか?",4+32,"Step4 ビットマップデータのアイコン表示") On Error Resume Next If MsgRt = 6 Then WshShell.RegWrite "HKEY_CLASSES_ROOT\Paint.Picture\DefaultIcon\", "%1" MsgBox "ビットマップデータをアイコン表示にしました",4+68,"Step4 ビットマップデータのアイコン表示" Else WshShell.RegWrite "HKEY_CLASSES_ROOT\Paint.Picture\DefaultIcon\", "C:\Progra~1\Access~1\MSPAINT.EXE,1" End If ---------------------------------------------------------------- On Error Resume Next Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.RegDelete "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Doc Find Spec MRU\" これは、「ファイルの検索」ダイアログで入力した、検索ファイル名の履歴を削除するものです。この履歴は、HKEY_ CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Doc Find Spec MRU\というキー以下に記録され ているので、RegDeleteメソッドで、このキーごと削除しています。RegDeleteメソッドは、引数として指定した値の名 前やキーを削除します。このように指定した文字列が"\"で終わっている場合は、値の名前ではなくキーとみなされま す。(これはRegRead、RegWriteメソッドでも同じ) なお、RegRead、RegDeleteでは指定したキーや値の名前が存在しない場合、「指定したファイルが見つかりません」 という実行時エラー(-2147024894)が発生します。この例ではOn Error Resume Nextを使って、キーが存在しない場合 は何もせず終了するようにしています。 ############################################################################### /////////////////////////////////////////////////////////////////////////////// // 10 Windows Scripting Host Sample ////////////////////////////////////////// コントロールパネルなどの操作 ========================================================== ---------------------------------------------------------------- '電源をオフにする(以下のどちらでも良い) Set WSHSHell=CreateObject("WScript.Shell") WSHShell.Run "C:\WINDOWS\RUNDLL32.EXE Shell32.dll,SHExitWindowsEx 1" Set WSHSHell=CreateObject("WScript.Shell") WSHShell.Run "C:\WINDOWS\RUNDLL.EXE USER.EXE,ExitWindows" ---------------------------------------------------------------- 'マシンの再起動 Set WSHSHell=CreateObject("WScript.Shell") WSHShell.Run "C:\WINDOWS\RUNDLL32.EXE Shell32.dll,SHExitWindowsEx 2" ---------------------------------------------------------------- 'Windowsの再起動 Set WSHSHell=CreateObject("WScript.Shell") WSHShell.Run "C:\WINDOWS\RUNDLL.EXE USER.EXE,ExitWindowsExec" ---------------------------------------------------------------- 'ログオフ Set WSHSHell=CreateObject("WScript.Shell") WSHShell.Run "C:\WINDOWS\RUNDLL32.EXE Shell32.dll,SHExitWindowsEx 0" ---------------------------------------------------------------- サスペンド(スタンバイ) Set Win = CreateObject("Shell.Application") Win.Suspend ---------------------------------------------------------------- 'これはシャットダウンのダイアログが出るタイプ。スタートメニューから終了するのと同じです。 Set Win =CreateObject("Shell.Application") Win.ShutdownWindows ---------------------------------------------------------------- '「画面のプロパティ」を表示 Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.Run "control.exe desk.cpl" ---------------------------------------------------------------- '「システムのプロパティ」の「デバイスマネージャ」タブを開く。指定する数値はタブの順番-1 Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.Run "control.exe sysdm.cpl ,1" ---------------------------------------------------------------- '「地域のプロパティ」を表示 Set Win = WScript.CreateObject("Shell.Application") Win.ControlPanelItem "intl.cpl" ---------------------------------------------------------------- '「アプリケーションの追加と削除のプロパティ」を表示 Set WSHShell = WScript.CreateObject("WScript.Shell") WSHShell.Run "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl" ---------------------------------------------------------------- /////////////////////////////////////////////////////////////////////////////////////////// To be continue..... ============================================================================== I-ichirow Suzuki _/_/_/_/_/_/_/_/_/_/_ URL : www.kg-group.com Top Page Mail : suzuki@kg-group.com /_/_/_/_/_/_/_/_/_/_/_/_ ICQ : 3743158