|
|  |
<![CDATA[
================================================================================
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 として内容に下記１行を記述して保存後ダブルクリック
-------------------------------------------------------------------------------
'お約束のアウトプット
MsgBox "Hello World!"
-------------------------------------------------------------------------------
次はこれ
-------------------------------------------------------------------------------
'シンプルすぎて役に立たないサンプル
InputBox "何か入力してください。"
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
'多少よくなったサンプル
Dim str '変数の宣言
str = InputBox ("何か入力してください。")
MsgBox str
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
'簡単な足し算（全角数字を入れると文字列結合されます。）
Dim var1
var1 = InputBox("数字を入力してください")
Dim var2
var2 = InputBox("もう１つ数字を入力してください")
Dim total
total = var1 + var2
MsgBox "最初の入力は：" & var1 & vbCRLF & _
"次の入力は ：" & var2 & vbCRLF & _
"足すと ：" & total
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
'全角数字を入れても半角に変換して計算してくれます。 cLng()
Dim var1
var1 = cLng(InputBox("数字を入力してください"))
Dim var2
var2 = cLng(InputBox("もう１つ数字を入力してください"))
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,と５つの配列を準備
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) '５文字目までを読み込み
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.....
==============================================================================
]]>インターネットスタートページ 鈴木維一郎 石橋三重子
|
|
|
|
|
|
