Internet Start Page  TOP  
 Road of Developers
 
 


================================================================================

Learn More About 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.....

==============================================================================


インターネットスタートページ 鈴木維一郎 石橋三重子
        
         
               
                   

©2000 kg-group Inc.