早々のアドバイスありがとうございます。

　このサンプルでは「厳しい」ことはよく分かりました。^^;

　C:\cmd.exe dir /S /B　>>　C:\test.txtで実行すると相当処理が早いですね。

＜今後の方針として＞
その結果（test.txt）から、txtファイルの頭から１レコードずつ読み込んで、「FleSystemObject」の各メソッドを使って、ファイルサイズ、作成年月日、更新年月日を取得し、カンマ区切りすれば、今より早くCSVファイル化できる可能性があると認識しています。
ここで、
〇　全フォルダ・ファイルパスを取得した結果(test.txt)を、ファイルオープン（OpenTextFile）して、レコードの最後(objInFile.AtEndOfStream)まで行単位で読み込む（objInFile.ReadLine）方法
〇　標準出力が終わるまで（objExec.StdOut.AtEndOfStream ）になるまで一　件ずつ処理する方法（objExec.StdOut.ReadLine ）とでは、

どちらの処理が早いと考えられますか？
（そもそも考え方が誤ってしたらすいません。）

　結局は両方やってみたいと思います。

>Gowasu_na さん
サンプルはもともとドライブ全部のフォルダを走査することを想定してないので、厳しいものがありますね。

私もFileSystemObjectで再帰を使ってフォルダを走査するスクリプトをいくつか作って使っていましたが、時間がかかるので他の手段（バックアップならrobocopy.exe、その他はPowerShell）に置き換えてます。

このサンプルは私にはこれ以上速くすることはできないです。
ファイル列挙を外部プログラムにまかせて、たとえば
cmd.exe dir /S /B
をWshShell.Execで実行してその結果を取得してやるとかでしょうか。多分相当速いです。

Execメソッドの使い方については当該連載でやってますので参考にしてください。

また質問させていただきます。

C:\のすべてのファイルをリスト化すると相当な時間を要することは予測できましたが、数時間たっても終わる気配がありません。(サンプル実行)
処理実行中は、CPU処理の負荷も平均60�l以上になります。
VBSの処理（別なコード記述）で、処理時間の短縮は望めないのでしょうか。

＜ファイルリスト対象＞

　C:\ →　ファイル数：157,146個　フォルダ数：28,074

　取得及びテキスト出力項目：objFolder.Path のみ

　＜処理が早くなれば、ファイル名、作成年月日、更新年月日の項目も入れまた、項目間にカンマを付加し、CSV出力したいと思っています。＞

変な質問で申し訳ありせん。^^;

よろしく、お願いします。

　

　

ご返答が遅くなってすいません。^^;

やっぱり、そうなんですね。

でも、エラー処理対処の仕方、勉強になりました。

過去ログも参照したいと思います。

また、ご相談させてください。

> Gowasu_na さん

お察しの通り、フォルダやファイルのアクセス権に引っかかっているためかと思います。
FileSystemObjectではフォルダやファイルのアクセス権を事前に調べる方法はおそらくないので、アクセス権がない場合に発生したエラーを抑制するしかないかと思います。

具体的にはFor Each〜Nextでファイル一覧およびサブフォルダ一覧を列挙している部分の前に
On Error Resume Next
その部分の後に
On Error Goto 0
と記述してやればいいかと思います。

On Error Resume NextとOn Error Goto 0の間でエラーが発生しても抑制され、そのまま次の行に制御を移します。

詳しくは当該連載のどこかでエラー処理の話を書いたと思うのでそれを参照してください。

また、ご教示願います。

C:\にあるフォルダとファイル一覧が全取得できたと思ったのですが、

C:\にある一部フォルダが取得できずに、エラーとなりました。

ホームページのサンプルを参考に、追加行を入れて実行してみました。

Option Explicit

'＜追加行＞
'On Error Resume Next

Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

Dim strMessage
strMessage = ""

Dim strParentFolder, objParentFolder

'strParentFolder = objFSO.GetParentFolderName(WScript.ScriptFullName)

'＜追加行＞
strParentFolder="C:\"

Set objParentFolder = objFSO.GetFolder(strParentFolder)


'親フォルダを表すFolderオブジェクトをプロシージャSearchFolderに渡す
Call SearchFolder(objParentFolder)


'Folderオブジェクトを引数に取り、そのフォルダに含まれるサブフォルダ、ファイルを
'列挙するSubプロシージャ。引数にはFolderオブジェクトを取る
Sub SearchFolder(objFolder)
    '引数に与えられたフォルダのパスを取得する
    strMessage = strMessage & objFolder.Path & vbCrLf
    
    '1つのファイルおよびファイルのセットを表すオブジェクト変数を宣言
    Dim objFile, objFiles
    
    'FolderオブジェクトのFilesプロパティを参照し、Filesコレクションを得る
    Set objFiles = objFolder.Files
    
    'フォルダに存在するファイルのFileオブジェクトを列挙
    For Each objFile In objFiles
        'ファイルパスを取得
        strMessage = strMessage & objFile.Path & vbCrLf
    Next

    Set objFile = Nothing
    Set objFiles = Nothing

    '1つのサブフォルダおよびサブフォルダのセットを表すオブジェクト変数を宣言
    Dim objSubFolder, objSubFolders
    
    'FolderオブジェクトのSubFoldersプロパティを参照し、Foldersコレクションを得る
    Set objSubFolders = objFolder.SubFolders

    'サブフォルダに対して、SubプロシージャSearchFolderを再帰呼び出しする
    For Each objSubFolder In objSubFolders
       Call SearchFolder(objSubFolder)
    Next
    Set objSubFolder = Nothing
    Set objSubFolders = Nothing
    
    'MsgBox strMessage
    
    
'---------------------------＜追加行＞--------------------------------------
   '--変数宣言--
   Dim objTS
   Dim intLen
   Dim strNewFileName
   Dim strMyPath

   '--オブジェクトの生成--
   Set objFSO = WScript.CreateObject( "Scripting.FileSystemObject" )

  '新しいファイルのパス
   strMyPath = WScript.ScriptFullName 'スクリプトの絶対パス
   intLen = InStrRev( strMyPath , "\" ) 'ディレクトリ部分の文字数
   strMyPath = Left( strMyPath , intLen ) 'ディレクトリ部分のパス

  '新しいファイル名
   strNewFileName = "ファイルリスト.txt"

   Set objFolder = objFSO.GetFolder( strMyPath )
   Set objTS = objFolder.CreateTextFile( strNewFileName , True , True)
  '----------------------

  '--本体--
   objTS.WriteLine strMessage
   objTS.Close

   '--オブジェクトの解放--
   Set objTS = Nothing
   Set objFolder = Nothing
   Set objFSO = Nothing
'--------------------------＜追加行＞----------------------------------------
    
End Sub

【実行結果】

’＜エラー（書き込みできませんとの結果表示）＞
'　以下、エラー場所
'フォルダに存在するファイルのFileオブジェクトを列挙
    For Each objFile In objFiles

　となり、失敗でしたが、フォルダのアクセス権とかが関係し、コレクションがobjFileに書き込めなかったのでしょうか。原因がわかりません。
　他のドライブ（I:\）ではすべて取得しているのですが。。。。。。
　よろしく、お願いします。

　

早々のご回答ありがとうございます。

ご教示のとおり、フォルダとファイル一覧が取得できました。（＾＾;）

分かりやすい解説ありがとうございました。

また、ご相談させてください。

>Gowasu_naさん

strParentFolder="C:\"
Set objParentFolder = objFSO.GetFolder(strParentFolder)

とやることでいけませんか？
ルートフォルダも他のフォルダと同様、GetFolderメソッドでFolderオブジェクトを取得することは可能です。

第18回　FileSystemObjectオブジェクトを利用する（3）の※ファイル：recursiveDir.vbsを参考にして、ファイルリストを作成していますが、ルートドライブの直下から、すべてのフォルダとファイルの属性を取得したいのですが、ドライブ直下のコレクションを取得する方法がわからなくて困っています。
静的に引数に(C:\)を入れたとしてもobjFolder.Pathが取得できないので、他の方法があればご教示願います。
なお、USBメモリ内にvbsを作成し、全ルートにあるフォルダやファイルリストを作成したいと考えています。
よろしく、お願いします。





※サンプルファイル：recursiveDir.vbs

早々のご返答ありがとうございます。

参考情報ありがとうございます。

早速、SFC miniについて学びたいと思います。

>Gowasu_na さん

RegEnumKeyEx や RegQueryInfoKey関数はWin32API関数なので、WSH/VBScriptから直接呼び出すことはできません。

これらの関数を実行するexeかCOM DLLを別途作成し、それをWSHスクリプトから呼び出す形になります。

Win32APIをWSHから直接呼び出すためのコンポーネント、SFC miniを使うことでも可能かもしれません。
http://sfcmini.sourceforge.jp/help/catid-19.html

USBメモリの最終マウント日時を探しています。
レジストリのタイムスタンプを取得するには、RegEnumKeyEx や RegQueryInfoKey関数を使えばならないことは分かりましたが、コードの記述（戻り値の取得方法）の仕方がよく理解できいません。サンプルとなる資料がありましたらご教示願います。

〇レジストリキーの場所

HKEY_USERS\<ユーザID>\Software\Microsoft\Windows\CurrentVersion\Explorer\MountPoints2\{2cc642a8-4b23-11e0-91f7-4487fc5adb66}

このキー値を関数で問い合わせて、戻り値：最後の書き込み時刻を取得したいと思っています。

よろしく、お願いします。

ありがとうございます。

> レコードロックは使えないでしょうか？

更新が重複するユーザ数は最大で3〜4名でして、VBAの１つのプロシージャで4〜5テーブルを更新しますので、標準のレコードロックより簡単な方法を探していました。

> クライアントが何らかの方法で取得した時刻をテーブルに書き込むのではなく、
> テーブルに書き込む時に発行するSQL内に、そのPCの時刻を取得するコードを含めればいいのではないでしょうか。

共有フォルダが置かれたPCの時刻を取得できるコードを探してみます。
ありがとうございました。

まず前提として、Accessはサーバー・クライアント構成にして複数クライアントからの接続を想定していないはずなので、そのような用途であればSQL Serverの導入を強くお勧めします。

ですがすでにAccessベースのシステムがありそれを使用せざるをえないという状況であれば、レコードロックは使えないでしょうか？

または排他処理用に利用者テーブルに時刻を書き込むのであれば、
クライアントが何らかの方法で取得した時刻をテーブルに書き込むのではなく、
テーブルに書き込む時に発行するSQL内に、そのPCの時刻を取得するコードを含めればいいのではないでしょうか。
その方が動作としては自然かと思います。

# メールアドレスは削除させていただきました。

簡便に排他処理を実装したいです　を投稿した者です。

メールアドレスが公開されるとは考えていませんでした。
当方の当方から　メールアドレスを消去して（非表示にして）もらえましたら
助かります。よろしくお願いします。

質問１）WSH を用いて、LAN内の共有フォルダが置かれたPCの時刻を取得できますか？
質問２）共有DBシステムのデータ更新を排他処理するため、WSH を用いて、当方の方法より簡便に出来そうでしたら、何らかの助言をください。

Access2003で作成したテーブルMDBを、LAN内の共有フォルダに置いて、Access2003〜2010 VBAで動作する、小さな情報共有システムを作って、運用開始しました。
複数ユーザによって、データ更新が重複して実行されなくするため、ごく簡単な排他処理として、共有MDBに「利用者テーブル」を作成して、各ユーザ（のマクロMDB）が WScript.Network で取得したPC情報と、排他宣言（する/しない）フラグ、排他開始日時、排他終了日時、を書き込み、排他したい時に、排他宣言フラグをONに切り換えています。
当方は出来れば、共有フォルダが置かれたPCの時刻を取得したいのですが、現時点で、その方法がわからず、自分のPCの時刻を書き込んでいますので、「利用者テーブル」に書き込まれる時刻を排他（判定）処理に用いるには少し危険です。
また、VBA、WSH、PowerShell 等で利用できる、当方の方法よりお勧めの「排他（判定）処理」方法をご存知でしたら、何らかの助言をもらえると助かります。

管理人牟田口大介さん
お返事ありがとうございます。
早速やってみます。
またわかならければ、書き込みするかもしれませんが、よろしくおねがいします

>宮川 さん

replaceメソッドを実行したかどうかを表す変数を用意すればいいのではないでしょうか。

var replaced=false;
do{
     ...
     if(!replaced)
     {
          strLne=strLne.replace(strRepl,strWith);
          replaced=true;
     }
     ...
}

あるいはReadAllメソッドでまとめて読み込み、その文字列に対してreplaceメソッドを
実行し、その結果をWriteメソッドで書き込みすれば、最初の文字列だけ置換されるかと
思います。対象ファイルの行数が少ないのならばこちらのほうが良いかもしれません。

以下のプログラムは、ファイル内にあるG00を全てG32L1に変換してしまいます。ファイル内の、最初に検索されたG00だけをG32L1に変換したいのですが、どうすればよいのでしょうか？
すみませんがよろしくお願いします。


<?xml version="1.0" encoding="Shift_JIS" standalone="yes" ?>
<package>
<job id="WordReplace">
<?job error="True" debug="True" ?>
<object id="objFs" progid="Scripting.FileSystemObject" />
<script language="JavaScript">
<![CDATA[
strRepl=/"G00";
strWith="G32L1";
var objArg=WScript.Arguments;
 
for(i=0;i<objArg.length;i++){
 strTmp= objFs.BuildPath (objFs.GetParentFolderName (WScript.ScriptFullName), objFs.GetTempName ());
 
 var objTs =objFs.OpenTextFile(objArg(i),1,false);
 var objTs2=objFs.OpenTextFile(strTmp,2,true);

 do{
  strLne=objTs.ReadLine();
  strLne=strLne.replace(strRepl,strWith);
  objTs2.WriteLine(strLne);
 }while(!objTs.AtEndOfStream);

 objTs.Close();
 objTs2.Close();
 objFs.DeleteFile(objArg(i));
 objFs.MoveFile(strTmp,objArg(i));

}
]]>
</script>
</job>
</package>

管理人牟田口大介さん
>チェックボックスにチェックが入っているかどうかを知る汎用的な方法はなさそうです。
明快なお答えありがとうございます。「できないこと」というのはなかなか書いて
いないので助かりました。

>coroさん
チェックボックスにチェックが入っているかどうかを知る汎用的な方法はなさそうです。
しかしフォルダオプションであればチェックはレジストリの設定に基づいて入りますので、レジストリの値を直接読み込めばよいでしょう。
たとえば「登録されている拡張子は表示しない」にチェックが入っているなら、

Set WshShell = WScript.CreateObject("WScript.Shell")
msgbox WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt")

の結果は「1」と表示されます。チェックが入っていない場合は「0」です。

RegWriteメソッドを使えば逆に設定を書き込むこともできます。
しかしダイアログで設定したときと異なり、設定が即時反映されないので注意が必要です。設定を反映させるには一度ログオフします。

突然失礼します。

Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Exec "C:\Windows\Explorer.exe"

Do Until objShell.AppActivate("マイ")
WScript.Sleep 100
Loop

objShell.SendKeys "%TO"
WScript.Sleep 500
objShell.SendKeys "{TAB 6}"
WScript.Sleep 500
objShell.SendKeys "{RIGHT 1}"
WScript.Sleep 500
objShell.SendKeys "{TAB 3}"
WScript.Sleep 500
objShell.SendKeys "{DOWN 21}"

WindowsXPで上記のスクリプトを実行すると、Explorerが開いて、
ALT-TOが実行されフォルダオプションが開きます。そこから「表示」タブまで
降りて、「□登録されている拡張子は表示しない」の項目が選択されます。
ここでチェックが入っているかの状態をスクリプトで得ることはできるんでしょうか？いろんなサイトを見てみても、このあたりの記述が無いんです。ご教示
いただけないでしょうか？色々なソフトの自動インストールに応用しようと
もくろんでます。

管理人牟田口大介さん

遅くなりましたが回答頂きありがとうございます

>Win7ではWMIのWin32_OperatingSystemクラスのOSArchitectureプロパティの値を見ることでx86かx64かを判別できます。
>OSArchitectureプロパティは文字列で、日本語環境では「32 ビット」とか「64 ビット」のような値が入っています。

簡単にソースで実現できびっくりしました、調べていたらWMIというものなんですね
Win32_OperatingSystemを調べていたらURLの資料が見付かったので、頂いたコードを参考しながら自分なりにモディファイしてみます

今回は本当にありがとうございました

>QLOOK さん
Win7ではWMIのWin32_OperatingSystemクラスのOSArchitectureプロパティの値を見ることで
x86かx64かを判別できます。
OSArchitectureプロパティは文字列で、日本語環境では「32 ビット」とか「64 ビット」のような値が入っています。

Set objWMIService = GetObject("winmgmts:" _
  & "{impersonationLevel=impersonate}!\\.\root\cimv2")

Set oses = objWMIService.ExecQuery _
  ("Select * From Win32_OperatingSystem")

For Each os In oses
     If InStr(os.OSArchitecture,"32") Then
          architecture="x86"
     ElseIf InStr(os.OSArchitecture,"64") Then
          architecture="x64"
     End If
Next

MsgBox architecture

VBScriptでWin7の動作ビットが32Bitなのか64Bitなのか切り分けすることは可能なのでしょうか？

よろしくおねがいいたします

>管理人さん
ありがとうございます
ちょっと色々試してみます

>cafetime さん
IE6ならばShell.Windows.Itemが現在アクティブなIEウィンドウを返すので、

Set Shell = WScript.CreateObject("Shell.Application")
Set window = Shell.Windows.Item
msgbox TypeName(window.document)
If TypeName(window.document) = "HTMLDocument" Then
     window.Quit
End If

これでいけたらしいんですが、IE8だと駄目ですね。

IE8をお使いならこちらのコードを使ってみてはいかがでしょうか。

IE7/IE8で、現在または最後にアクティブなIEを捕捉する。(その２): Windows Script Programming
http://scripting.cocolog-nifty.com/blog/2010/04/ie7ie8ie-855f.html
IE7/IE8で、現在または最後にアクティブなIEを捕捉する。: Windows Script Programming
http://scripting.cocolog-nifty.com/blog/2009/08/ie7ie8ie-ee95.html

MsgBox ie.LocationURL
を
ie.Quit
にすればアクティブなIEウィンドウを閉じます。

管理人さん
ありがとうございます、確かにこのままだとすべてのIEが閉じてしまいますね
アクティブなウィンドウだけを閉じたいのですがそれがわかりません
具体的にどのように記述したらよいでしょうかIEは8です
素人ですみません

>cafetime さん
立ち上がっているIEウィンドウのリストはShell.ApplicationオブジェクトのWindowsメソッドで取得できます。
この方法で取得したWindowオブジェクトは、InternetExplorer.Applicationオブジェクトと同じメソッド、プロパティを持ちます。
ただしこのメソッドはIEウィンドウのほかに開いているフォルダウィンドウのインスタンスも取ってくるので
それを除外します。
（TypeName(window.document)が"HTMLDocument"ならIE、"IShellFolderViewDual3"ならフォルダ）
あとは取得したWindowオブジェクトに対し、Quitメソッドを実行するとそのウィンドウが閉じます。
閉じるウィンドウを選択したい場合は、window.LocationURLでURLが、window.document.titleでページタイトルがそれぞれ取得できますので、
その値に応じて処理を分けてください。

以下、コードのひな形を置いておきます。このコードそのままだとすべてのIEウィンドウを閉じます。

Set Shell = WScript.CreateObject("Shell.Application")
Set dicWindows=WScript.CreateObject("Scripting.Dictionary")

For Each window In Shell.Windows
     If TypeName(window.document) = "HTMLDocument" Then
          url = window.LocationURL
          title = window.document.title
          dicWindows.Add window,""
     End If
Next

For Each window In dicWindows
     window.Quit
Next

ど素人です　今勉強中でサンプルを見ながら作成しております
簡単なことなのかも知れませんが、ＩＥの操作を勉強しておりますが
まったくわかりません、ご教授願います

問題は、ＩＥの立ち上げはできますが、現在アクティブなＩＥの閉じ方が
わかりませんどのように記述したらよいでしょうか？

>Gowasu_na さん
はい、頑張ってくださいね。
手前味噌で恐縮ですが、@ITで連載していたチェック式WSH入門はVBScriptの基礎文法からみっちり押さえてます。
学習の足掛かりになればと思います。
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh01/cformwsh01_01.html

管理人牟田口大介 さん

いつも親切･ご丁寧な対応有難うございます。

ご返答が遅くなってすいません。^^;

今回の質問の件、大変失礼しました。

ご指摘のとおり、自分でも、勉強方法を間違っているなと感じました。

初心に戻り、VBScriptの基礎文法から勉強し直したいと思います。

また、ご質問をさせてください。^^;

>Gowasu_na さん
>バリアント型 (Variant) は、数値と文字列のいずれの情報も含めることができます

バリアント型は数値や文字列などなんでも格納可能な型です。
VBScriptで扱う変数はすべてバリアント型です。
「なんでも格納可能」というのは「同時に複数の種類の値が格納可能」という意味ではありません。
たとえば文字列のデータが格納されている場合は、その変数は正確には「内部処理形式がStringのバリアント型」となります。
実際にコードから扱う場合は、この変数は文字列型として扱う必要があります。
今回の場合、GetStringValueメソッドはその名の通り「内部処理形式がStringのバリアント型」の値かNullを返すので、Integerや他の型の値が入ることは想定しなくていいんじゃないでしょうか。

>の２行目までしか、出力できません。

コードの意味を理解しながら記述していますか？
不必要なDo...Loopや不適切なIf...Elseなどが散見され、必要とするロジックがコードに落とし込めていません。

ここでやるべきことは、
１．「"SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"」のサブキーを列挙
２．各サブキーに存在する"DisplayName"エントリの値を取得する
です。
あとはそれぞれ取得できなかった際のことを考慮するだけです。
よってコードはこんな感じになるでしょう。

Set reg = CreateObject("WbemScripting.SWbemLocator").ConnectServer(DEF_MACHINE, "root\default").Get("StdRegProv") 
ret = reg.EnumKey(HKEY_LOCAL_MACHINE, REG_PATH, arrSubKeys)
If ret=0 Then
     For Each enmKey In arrSubKeys
          ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, REG_PATH & "\" & enmKey, "DisplayName", varValue)
          If ret = 0 And varValue <> "" then
               strMsgTotal = strMsgTotal & varValue & vbCRLF
          End if
     Next
End If
Msgbox strMsgTotal

まず、「何をすべきか」をはっきりとさせ（先ほどのように文章にしてみるのも効果的です）、それを過不足なくコードに落とし込むことが重要です。
コードは書いた通りにしか動かないので、コードに過不足や間違いがあれば期待通りに動作することはありません。
なんとなく、こういう動作をさせてみたいので、なんとなく、こういう風なコードを書けば動くかな？という感じでは駄目だということです。
ぜひ、VBScriptの基礎文法から勉強しなおしてみてください。

管理人牟田口大介 さん

お世話になります。（早々のご回答ありがとうございます）

variantのstringには、integer整数が入ると思っていました。
バリアント型 (Variant) は、数値と文字列のいずれの情報も含めることができます。とネットで掲載してあったもので；^^;
http://www.keynus.co.jp/~uhara/html/vbscript/7.htm

varValue = ""の件、了解しました。また、DisplayNameがNullの場合があると言うこで理解してします。

インストール情報をすべて、テキストに出力したいのですが、

下記の記述のコードでは、

インストール情報の取得
Adobe Flash Player ActiveX

の２行目までしか、出力できません。

*******************************************
option Explicit
Const DEF_MACHINE = "."'As String
'' レジストリ定数
Const HKEY_CLASSES_ROOT = &H80000000& 'As Long
Const HKEY_CURRENT_USER = &H80000001& 'As Long
Const HKEY_LOCAL_MACHINE = &H80000002& 'As Long
Const REG_SZ     = 1  'As Long
Const REG_EXPAND_SZ  = 2  'As Long
Const REG_BINARY   = 3  'As Long
Const REG_DWORD   = 4  'As Long
Const REG_MULTI_SZ  = 7  'As Long
'' 検索レジストリパス
Const REG_PATH = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Dim arrSubKeys 'As WbemScripting.SWbemObjects  '' レジストリサブキーコレクション
Dim enmKey  'As WbemScripting.SWbemObject  '' レジストリサブキー列挙値
Dim ret   'As Long  '' レジストリ値処理結果(0:OK 1:NG)
Dim varValue 'As Variant  '' レジストリ値
Dim strMsgTotal 'インストール情報格納用（取得データ格納）
Dim strMyPath 'インストール情報格納用(取得情報の書出し場所指定)
Do
'' レジストリプロバイダへ接続
With CreateObject("WbemScripting.SWbemLocator").ConnectServer(DEF_MACHINE, "root\default").Get("StdRegProv")   
 '' レジストリキーの取得
 ret = .EnumKey(HKEY_LOCAL_MACHINE, REG_PATH, arrSubKeys)
 '' キーすら取得できない場合は中断
'確認用（ret） 
 Msgbox ret
 If ret <> 0 Then
  Exit Do
 End If
 '' レジストリキーの列挙
 For Each enmKey In arrSubKeys
 '' システムコンポーネントは対象外とする
 
'確認用（取得キー）
'   Msgbox enmkey

 If ret <> 0 Or varValue = "" Then
 '' 表示名を持った項目を対象とする
  ret = .GetStringValue(HKEY_LOCAL_MACHINE, REG_PATH & "\" & enmKey, _
   "DisplayName", varValue)
   
'確認用(DisplayName値がNullの場合がある)   
'   Msgbox varValue

'確認用（ret） 
 Msgbox ret

  If ret = 0 then

   'テキストファイルに書き出し
   strMsgTotal = "インストール情報の取得" & vbCRLF

   strMsgTotal = strMsgTotal & varValue & vbCRLF

'   WScript.Echo varValue

  End if
 End If
 Next
 Exit Do

End With
Loop

'確認用（strMsgTotal）
Msgbox strMsgTotal

'テキストファイルに書き出し
Call fsoWriteNewText( strMsgTotal )

WScript.Quit


'取得情報の書出し及びファイルの生成--------------------------

Sub fsoWriteNewText( strMsgTotal )

'--変数宣言--
Dim objFSO
Dim objFolder
Dim objTS

Dim intLen
Dim strNewFileName
'Dim strMyPath
'------------

'新しいファイルのパス
strMyPath = WScript.ScriptFullName 'スクリプトの絶対パス
intLen = InStrRev( strMyPath , "\" ) 'ディレクトリ部分の文字数
strMyPath = Left( strMyPath , intLen ) 'ディレクトリ部分のパス

'新しいファイル名
strNewFileName = "インストール情報取得.txt"

'--オブジェクトの生成--
Set objFSO = WScript.CreateObject( "Scripting.FileSystemObject" )

Set objFolder = objFSO.GetFolder( strMyPath )
Set objTS = objFolder.CreateTextFile( strNewFileName ,True,True )
'----------------------

'--本体--
objTS.WriteLine strMsgTotal
objTS.Close

'--オブジェクトの解放--
Set objTS = Nothing
Set objFSO = Nothing

End Sub
***************************************

指摘部分をご教示していただければ幸いです。

なんとか、出力したいです。

よろしく、お願いします。

>Gowasu_na さん
varValueはvariantのstring、0はintegerだからvarValue = 0がエラーになってるだけじゃないんですか？
varValue = ""なのでは。

管理人牟田口大介 さん

早々なご返答ありがとうございます。

恐縮ですが、次はアプリケーションのインストール情報の取得について学習しています。

コードは以下のとおりです。

----------------------------------------------

Option Explicit
Const DEF_MACHINE  = "."'As String
'' レジストリ定数
Const HKEY_CLASSES_ROOT  = &H80000000&  'As Long
Const HKEY_CURRENT_USER  = &H80000001&  'As Long
Const HKEY_LOCAL_MACHINE  = &H80000002&  'As Long
Const REG_SZ         = 1   'As Long
Const REG_EXPAND_SZ   = 2   'As Long
Const REG_BINARY      = 3   'As Long
Const REG_DWORD      = 4   'As Long
Const REG_MULTI_SZ    = 7   'As Long
'' 検索レジストリパス
Const REG_PATH = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Dim arrSubKeys 'As WbemScripting.SWbemObjects   '' レジストリサブキーコレクション
Dim enmKey   'As WbemScripting.SWbemObject    '' レジストリサブキー列挙値
Dim ret      'As Long    '' レジストリ値処理結果(0:OK 1:NG)
Dim varValue  'As Variant   '' レジストリ値
Dim strMsgTotal 'インストール情報格納用
Dim strMyPath 'ただインストール情報格納用
Do
  '' レジストリプロバイダへ接続
 With CreateObject("WbemScripting.SWbemLocator").ConnectServer(DEF_MACHINE, "root\default").Get("StdRegProv")     
  '' レジストリキーの取得
  ret = .EnumKey(HKEY_LOCAL_MACHINE, REG_PATH, arrSubKeys)
  '' キーすら取得できない場合は中断(まずないはず)
  If ret <> 0 Then
   Exit Do
  End If
  '' レジストリキーの列挙
  For Each enmKey In arrSubKeys
  '' システムコンポーネントは対象外とする

  If ret <> 0 Or varValue = 0 Then
  '' 表示名を持った項目を対象とする
   ret = .GetStringValue(HKEY_LOCAL_MACHINE, REG_PATH & "\" & enmKey, _
      "DisplayName", varValue)
   If ret = 0 then

     'テキストファイルに書き出し
     strMsgTotal = "インストール情報の取得" & vbCRLF
     strMsgTotal = varValue & vbCRLF

     Call fsoWriteNewText( strMsgTotal )

'     WScript.Echo varValue
   End if
  End If
  Next
  Exit Do
End With
Loop

'取得情報の書出し及びファイルの生成--------------------------

Sub fsoWriteNewText( strMsgTotal )

'--変数宣言--
Dim objFSO
Dim objFolder
Dim objTS

Dim intLen
Dim strNewFileName
'Dim strMyPath '上でPublic宣言しているので不要
'------------

'新しいファイルのパス
strMyPath = WScript.ScriptFullName 'スクリプトの絶対パス
intLen = InStrRev( strMyPath , "\" ) 'ディレクトリ部分の文字数
strMyPath = Left( strMyPath , intLen ) 'ディレクトリ部分のパス

'新しいファイル名
strNewFileName = "インストール情報取得.txt"

'--オブジェクトの生成--
Set objFSO = WScript.CreateObject( "Scripting.FileSystemObject" )

Set objFolder = objFSO.GetFolder( strMyPath )
Set objTS = objFolder.CreateTextFile( strNewFileName ,True,True )
'----------------------

'--本体--
objTS.WriteLine strMsgTotal
objTS.Close

'--オブジェクトの解放--
Set objTS = Nothing
Set objFSO = Nothing

End Sub

WScript.Quit

-------------------------------------
ここからが質問ですが、

（基本的なことかもしれませんが）^^;

行：　33 
文字： 4
エラー:　型が一致しません。：'[String:"AdobeFlashPlayer1"]
コード: 800A000D
ソース：MicroSoft　VBScript　実行時エラー

とでてしまいます。

33行目を見てみると、

If ret <> 0 Or varValue = 0 Then

ですが、retはlong型　varValueはVariant型です。

なぜ、型が一致しないか、まだ理解していません。

ご教示よろしくお願いします。

なお、現時点では、スクリプトを実行すると、テキストファイルは作成しており、Adobe Flash Player 10 ActiveXの文字列が書き込まれています。



　
                

管理人牟田口大介 さん

いつもお世話になります。

仕事場のパソコン(XP,Vista)では、デバイスが確認できませんでしたが

自宅の環境では、フロッピーデバイスはないですが、DriveType=5

では、うまく取得できました。

なんでかな？？？？

とりあえず、また確認します。^^;

お手数をお掛けして、すいませんでした。

>Gowasu_na さん

こちらの環境ではWin32_LogicalDiskでCD-ROMがDriveType=5、フロッピードライブがDriveType=2としてばっちり取得できてますね。
そちらの環境はどのような構成でしょうか。
あとすべての環境で同じようにダメですか？

管理人牟田口大介 さん

いつもお世話になります。

また、早々のご回答ありがとうございます。

今回は、デバイス情報の取得について質問です。

Win32_LogicalDiskクラスを使いデバイス情報を取得しようと考えています。

以下に、コードを示します。
****************************************************
'【HDD情報の取得】
Function GetDiskInformation

Dim strComputer
Dim strMsg

Dim objWMIService
Dim colItems1 , objDisk1
Dim colItems2 , objDisk2

Dim intI,StatusCnt,Flg


strMsg = vbCRLF & "ディスク情報一覧" & vbCRLF
strMsg = strMsg & strLineTL & vbCRLF

strComputer = "."

'固定ディスク情報取得（StatusCnt = 3）
StatusCnt = 3

Flg = 1

Do Until Flg = 4

'リムーバルディスク情報取得（StatusCnt = 2）
If Flg = 2 Then StatusCnt = 2

Flg = Flg + 1

IF Flg = 4 Then
  Exit Do
End if

'オブジェクトの宣言--------------------------
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems1 = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk WHERE DriveType = " & StatusCnt)

'--------------------------------------------
'リムーバルディスク情報取得（StatusCnt = 2）
StatusCnt = 2

For each objDisk1 in colItems1

  'ディスクが２個以上あった場合の区切り線
  intI = intI + 1
  If intI > 1 then strMsg = strMsg & strLineBt & vbCRLF
'  strMsg = strMsg & "Model: " & objDisk2.Model & vbCRLF
  strMsg = strMsg & "ドライブID: " & objDisk1.DeviceID & vbCRLF
  strMsg = strMsg & "ボリューム名: " & objDisk1.VolumeName & vbCRLF
  strMsg = strMsg & "SerialNumber: " & objDisk1.VolumeSerialNumber & vbCRLF
'
' MsgBox objDisk.DeviceID
  strMsg = strMsg & "Description：" & objDisk1.Description & vbCRLF
  strMsg = strMsg & "FileSystem：" & objDisk1.FileSystem & vbCRLF
  strMsg = strMsg & "容量: " & GetSizeAndUnit( objDisk1.Size ) & vbCRLF
  strMsg = strMsg & "空き容量: " & GetSizeAndUnit( objDisk1.FreeSpace ) &  vbCRLF
  strMsg = strMsg & "使用量: " & GetSizeAndUnit( objDisk1.Size -  objDisk1.FreeSpace ) & vbCRLF
 

Next
strMsg = strMsg & strLineTL & vbCRLF

'デバイス情報取得
'------------------------------------------------------------------------------------------------------
If Flg = 3 Then
  Set colItems2 = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive",,48)
  For each objDisk2 in colItems2
    strMsg = strMsg & "【インターフェースタイプ:】 " & objDisk2.InterfaceType & vbCRLF
    strMsg = strMsg & " メディアタイプ： " & objDisk2.MediaType & vbCRLF
    strMsg = strMsg & " モデルタイプ: " & objDisk2.Model & vbCRLF
  Next
End If

strMsg = strMsg & strLineTL & vbCRLF
'-----------------------------------------------------------------------------------------------------
 
 
GetDiskInformation = strMsg

Loop


'変数の開放
Set objDisk1 = Nothing
Set ColItems1 = Nothing
Set objDisk2 = Nothing
Set ColItems2 = Nothing
Set objWMIService = Nothing

End Function
*********************************************
ここから質問ですが、

デバイス情報を取得するには

　DriveTypeプロパティ指定しているのですが、

　　（参照先：http://msdn.microsoft.com/ja-jp/library/Aa394173）
　
　　固定ハードディスク　→　StatusCnt = 3　（取得可）固定ハード

　　リムーバルディスク　→　StatusCnt = 2　（取得可）usbメモリ

　　ＰＣ本体付属の3.5インチフロッピーディスク及びＣＤ−ＲＯＭデバイス
　　
　　の情報（媒体挿入しても×）が取得できません。

　　他の　ステータス値も入れてみるのですが、

　　コンパクトディスク　→　StatusCnt = 5　（×）

　　　　　　RAMディスク　→　StatusCnt = 6　（×）


　Win32_LogicalDiskクラスに以外に、取得するクラスが別にあるのでしょうか？

　悩んでいます。どうか、よろしくお願いします。

>Gowasu_na さん
>(unicode文字)が含まれていたようです。

「-」に似た字なんかはunicode文字でたくさんあるので、気づかずまぎれてることがよくありますね。

>デバックの際に、何か注意点があれば、ご教示をお願いします。

システム情報を取得されているとのことですよね。
これは一つ一つ、地道に、どのシステム情報が取得できるのか、あるいは取得できないのかを
調べていくしかないんじゃないでしょうか。
具体的には、すべてのシステム情報をまとめて出力してみるのではなく、あるシステム情報だけを
出力してみた場合、取得できているかどうかをそれぞれの項目で調べるということです。

全部取得できてないからテキストへの出力が空になってしまう、という可能性もあるでしょうが…

まずはそこからやってみてください。
取得できないものがあれば、それをお知らせください。個別に理由を考えていきましょう。

管理人牟田口大介 さん

いつもリアルタイムにご返答ありがとうございます。
大変、勉強になります。

それと、ご返事が遅れてすいません。^^;

Set objTS = objFolder.CreateTextFile( strNewFileName , True, True )

でうまくいきました。(unicode文字)が含まれていたようです。

いろんな経験をつまなければならないようですね。（助かりました。）

話はかわりますが、

先日、USB接続デバイス情報をレジストリから取得する方法を学びました。

＜試験結果＞

Windows　Xp　の環境では、空のテキストファイルが作成されたので、調査したいと思います。（Windows7・WindowsVistaともに取得ＯＫでした。）

デバックの際に、何か注意点があれば、ご教示をお願いします。

なお、タイムスタンプにあっても、レジストリの場所を検索して、値を取得

できるようにしたいと思います。

また、ご指導のほどよろしくお願いします。

>Gowsu_na さん
タイムスタンプは前から書いてますとおり、レジストリのタイムスタンプを読む以外の方法はないんじゃないですかねー？

>エラー：書き込みできません
strMsgTotalにShift_JISには含まれないunicode文字が含まれていたりしませんか？
Set objTS = objFolder.CreateTextFile( strNewFileName , True, True )
とするとShift_JISではなくUnicode(UTF-16)のテキストファイルを作成できるので、まずはこれで書き込んでエラーがでるかどうか確認してみてください。
もしこれで書き込みができるようなら、strMsgTotalにunicode文字が含まれています。
あらかじめunicode文字を除去するか、UTF-16でテキストファイルを保存するようにしてください。

もしそれでもエラーが出るとしたらファイルがリードオンリーになっているか、書き込み権限がないかのどちらかと思います。

管理人牟田口大介 さん

先日は、早々なご回答ありがとうございました。＾＾；

なんとか、理解できるように努力します。

「未だ、タイムスタンプ取得に奮闘中」です。

今回は質問を変えまして、

以下のような、Subプロシージャを作成しています。

'取得情報の書出し及びファイルの生成--------------------------

Sub fsoWriteNewText( strMsgTotal )

'--変数宣言--
Dim objFSO
Dim objFolder
Dim objTS

Dim intLen
Dim strNewFileName
'Dim strMyPath '上でPublic宣言しているので不要
'------------

'新しいファイルのパス
strMyPath = WScript.ScriptFullName 'スクリプトの絶対パス
intLen = InStrRev( strMyPath , "\" ) 'ディレクトリ部分の文字数
strMyPath = Left( strMyPath , intLen ) 'ディレクトリ部分のパス

'新しいファイル名
strNewFileName = "システム情報取得.txt"

'--オブジェクトの生成--
Set objFSO = WScript.CreateObject( "Scripting.FileSystemObject" )

Set objFolder = objFSO.GetFolder( strMyPath )
Set objTS = objFolder.CreateTextFile( strNewFileName , True )
'----------------------

'--本体--
objTS.WriteLine strMsgTotal
objTS.Close

'--オブジェクトの解放--
Set objTS = Nothing
Set objFSO = Nothing

End Sub

------------------------------------------------------------------

ここで、Windows Vista環境　で　この処理を実行したとき、

'--本体--
objTS.WriteLine strMsgTotal　←　実行時エラー（書き込みエラー）
objTS.Close

の部分で「実行時エラー」となます。

変数（strMsgTotal）には、システム取得情報（ドライブ情報取得等）＋　

vbCRLFが入り、区切り文字として「-」をドライブ情報間に挟んでいます。
　
なお、Windows　7　及び　windows　Xp　の環境では、このSubプロシージャを使っても、実行時エラー（書き込みエラー）は発生しません。

これは、どういうことなのでしょうか。

（「-」が入っているから？？？）
直前のデバッグ（Msgbox）では、中身が表示されます。


★エラーコードは

エラー：書き込みできません

コード：800A0046

ソース：MicroSoft　VBScript　実行時エラー

です。

>Gowsu_na さん

'COMオブジェクト　→　基本的に、1 つまたは複数のタスクを実行するためにアプリケーションで使われるブラック ボックスのようなものであるとは（ネットで調べました）
'どのような意味なのでしょうか。？

この文章を書いた方は「ブラックボックス」という単語から、「利用者は特に意識をしなくてもいい」と言いたいのではないでしょうか？
要するにCOMオブジェクトとは便利機能の塊で、スクリプトを書く場合に利用すると色々できて便利ということですね。

COMとは何か、オブジェクトとは何か、という話になると長くなりますが
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh09/cformwsh09_01.html
↑あたりにオブジェクトとは何かということを書いてます。

COMっていうのはWSHを支えている技術で、アプリケーションを部品化する技術です。その部品はCOMコンポーネントと呼ばれます。
WSHのみならずIE、Officeなど多くのアプリケーションがCOMを採用しています。
COMコンポーネントはWSHなど、ほかのアプリからも呼べます。
COMコンポーネントに含まれるオブジェクトがCOMオブジェクトで、WSHなどではCOMオブジェクトの種類を識別するProgID(WScript.Shellなど)を指定し
CreateObjectすることで実際にそのオブジェクトを使用することができるようになります。

'ConnectServerする際に名前空間が「root\default」を明示的に指定しています。（とネットで調べました。）
'これはレジストリにアクセスするための決まり文句と考えてよいのでしょうか？

'名前空間が「root\default」、クラスが「StdRegProv」（レジストリにアクセスするための決まり文句？）

WMI（Windowsのシステム管理用の機能群。これもCOMが支えている技術です）のStdRegProvクラス（レジストリに関する情報を含むクラス）は
名前空間（クラスが所属するフォルダのようなもの）root\defaultに属しているので明示的に指定が必要です。
というのもWMIで名前空間を指定しない場合はroot\cimv2を読みに行くので。

'連想配列の定義の理解でいいのでしょか？
'通常の配列の場合は数字をインデックスとして値を格納しますが、連想配列の場合は文字列をインデックスとすることができます。(ネットで調べました)

そうです、これは連想配列です。
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh19/cformwsh19_02.html

'レジストリへアクセスするための関連付けと理解していいのでしょうか？

Constは定数定義のためのステートメントです。
通常の変数は値が変更できますが、Constで定義した値は不変の定数です。
&H80000002はStdRegProvクラスにおいてHKLMを意味する値なので、このように定義しておくことでソースの可読性を上げるわけです。

'追加（連想配列(usbDevices)にFriendlyName情報とdevice.instanceIDをキーに、deviceを関連づけることの理解でよいのでしょうか？
'未設定のキー(key)に項目(item)を関連付けます。（キーが存在する場合はエラー）とネットで調べました。
'（キーが存在する場合はエラー）とはどういったことが考えられますか？

連想配列はキーが重複しないというのが前提条件です。
よって、連想配列にはキーが重複しない値をキーに選びます。
今回はキーは何でもよいのですが、"[FriendlyName]\[instanceID]"をキーにすれば重複することはありえないのでそうしています。
なんで重複することがありえないかというと、これはレジストリのパスだからです。レジストリのパスは一意に定まりますので。

そもそもここは連想配列を使わなくても通常の配列でもいけます。
なんで連想配列を使ったかというと、配列のサイズを変更するのがVBSの通常の配列だとちょっとめんどくさいからです。

'devicesKeyキーの配下にあるレジストリエントリの名前(値)の一覧が valuesに残る（配列を作ってくれる）
'末尾の「types」の部分が理解できません？ご教示願います

たしかにこのEnumValuesメソッドは変な仕様なので私も戸惑いましたが、ようするにたとえばvalues(3)に入ってるエントリの名前の、
エントリの種類はtypes(3)に入る、というだけのことです。

'データの種類が REG_BINARY である名前付きの値のためのデータ値を返します。とネットで調べました。
'また、GetBinaryValue メソッドは、成功の場合は 0、エラーが発生した場合はほかの値となる uint32 を返します。とネットで調べました。
'名前付きの値のためのデータ値を返しますとは、バイナリ値で返すのでしょうか？

なんか直訳っぽい文章で分かりにくいですが、ここは普通に「GetBinaryValueメソッドはREG_BINARYの値を読み込み、結果をバイナリ値（バイト配列）で取得できます。」という風な理解でいいとおもいます。
バイナリ値はメソッドの戻り値で返されるのではなく、引数（ここではbinary）に入るところが注意点です。
メソッド自体の戻り値は、正常に読み込めれば0、失敗した場合は0以外の整数になります。

'ここの回し方が、よく理解できていません。^^;
'step2で回すことは、１文字が16進(FF)表記だからでしょうか？
  For J = 0 To Ubound(binary) step 2

Unicodeは2バイトで1文字だからです。
1文字を読み込むには2バイトまとめて読まなければいけません。
 
'ChrW 関数はUnicode 文字セットの文字を含む文字列型で返します。（とネットで調べました。）
'この部分をChrW(binary(J)+binary(J+1)*256)を分かりやすくご教示願います。
'ここがよく分かっていません。重点的にお願いします。
   strValue = strValue & ChrW(binary(J)+binary(J+1)*256)

binaryという配列はバイト配列です。バイト型は0〜255の値が入ります。
今回は2バイトの値を読むので、読み込む値は0〜65535になります。
読み込み方ですが、今回のUnicode格納形式はリトルエンディアンなので、最初の1バイト目の値と、2バイト目の値を256倍したものの合計になります。
詳しくはリトルエンディアンという単語で調べてみてください。

'連想配列(usbDevices)のkeysの値の列挙はどこのソース部分で格納されたものなのでしょうか？

usbDevices.Add device.name & "\" & device.instanceID,deviceというところです。

'接続されたUSB機器を記憶装置として認識し制御する汎用のドライバプログラムの値が、53f56307-b6bf-11d0-94f2-00a0c91efb8b及び
'53f5630d-b6bf-11d0-94f2-00a0c91efb8bと考えてよろしいのでしょうか？

前に紹介したページにそう書いてあったので、そのままコードに反映させました。

>　　また、当方では、サクラエディタを使用しています。
>　　お勧めの、デバッガ機能付のソフトがあれば、ご教示願います。

以前紹介したものはこんなかんじです。
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh01/cformwsh01_03.html

今ならVS2010 Express Edition or スクリプトデバッガ　ですかね…
この辺りさんこうにしてみてください
http://www37.atwiki.jp/mima3/pages/70.html
http://www.sio.no-ip.com/mt/shio/archives/2005/05/wsh-os.html
マクロが使えるテキストエディタなら、これらのデバッガを実行するコマンドを定義してやればいいと思います。

個人的にはWSHの開発にデバッガは使わなかったりします。MsgBoxで昔ながらのprintデバッグですね^^;

管理人牟田口大介 さん
いつもお世話になります。
先ほどの質問の件ですが、色々と書いてしまいすいません。^^;

→　全体の流れは一応、理解できたと思っています。

以下のところのだけでも、できれば解説方よろしくお願いします。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'ここの回し方が、よく理解できていません。^^;
'step2で回すことは、１文字が16進(FF)表記だからでしょうか？
  For J = 0 To Ubound(binary) step 2
 
'ChrW 関数はUnicode 文字セットの文字を含む文字列型で返します。（とネットで調べました。）
'この部分をChrW(binary(J)+binary(J+1)*256)ご教示願います。
'ここがよく分かっていません。重点的にお願いします。
   strValue = strValue & ChrW(binary(J)+binary(J+1)*256)
  Next
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
　　また、当方では、サクラエディタを使用しています。
　　お勧めの、デバッガ機能付のソフトがあれば、ご教示願います。

　　よろしく、お願いします。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

管理人牟田口大介 さん
色々と勉強させて頂いています。大変ありがとうございます。
先日、ご指摘頂いた項目を修正した結果、うまく動作し、テキスト出力することができました。^o^
理解不足もあり、ソースコードを頂いてから、最初から勉強することとしました。^^;
疑問点を付したソースコードを添付しますので、ご解答のほどよろしくお願いします。
以下のとおりです。

'ユーザ定義クラスを定義
Class USBDevice
   Public instanceID
   Public name
   Public lastDrive
   Public isStorageDevice
   Public diskStamp
End Class

'Wscript.CreateObjectメソッドを使用してCOMオブジェクトを生成（とネットで調べました。）
'COMオブジェクト　→　基本的に、1 つまたは複数のタスクを実行するためにアプリケーションで使われるブラック ボックスのようなものであるとは（ネットで調べました）
'どのような意味なのでしょうか。？
Set Locator = WScript.CreateObject("WbemScripting.SWbemLocator")

'ConnectServerする際に名前空間が「root\default」を明示的に指定しています。（とネットで調べました。）
'これはレジストリにアクセスするための決まり文句と考えてよいのでしょうか？
Set Service = Locator.ConnectServer(vbNullString, "root\default")

'名前空間が「root\default」、クラスが「StdRegProv」（レジストリにアクセスするための決まり文句？）
Set Reg = Service.Get("StdRegProv")

'連想配列の定義の理解でいいのでしょか？
'通常の配列の場合は数字をインデックスとして値を格納しますが、連想配列の場合は文字列をインデックスとすることができます。(ネットで調べました)
Set usbDevices=CreateObject("Scripting.Dictionary")

'レジストリへアクセスするための関連付けと理解していいのでしょうか？
Const HKEY_LOCAL_MACHINE = &H80000002

'rootkey（USBSTOR情報パス）
rootKey = "SYSTEM\ControlSet001\Enum\USBSTOR"

'devicekeyへ格納（MountDevice情報パス）
devicesKey = "SYSTEM\MountedDevices"

'Keysへ格納（USBSTOR情報すべてのサブキーの名前を取得（列挙）→keysへ）
Reg.EnumKey HKEY_LOCAL_MACHINE, rootKey, keys

'keys変数の最大値まで検索
For I=0 To UBound(keys)

'subKeysへ格納（keys情報すべてのサブキーの名前を取得(列挙)→subkeysへ）
   Reg.EnumKey HKEY_LOCAL_MACHINE, rootKey & "\" & keys(i), subKeys

'subkeysの最大値まで検索（subkeys取得値 →　value）
   For J=0 To UBound(subKeys)
'GetStringValue データの種類が REG_SZ である名前付きの値に対するデータ値を返します。
     Reg.GetStringValue HKEY_LOCAL_MACHINE,rootKey & "\" & keys(i) & "\" & subKeys(J), "FriendlyName", value

'ユーザ定義クラス（USBDevice）をdeviceにセット（先頭行でに宣言しているユーザ定義クラス）     
     Set device=New USBDevice
     
'device.instanceIDへ格納（インスタンスＩＤ情報）
     device.instanceID=subKeys(J)
     
'device.nameへ格納（FriendlyName情報）
     device.name=value
     
'device.diskStampへ格納（未定義）     
     device.diskStamp=GetRegTimeStamp("HKEY_LOCAL_MACHINE\" & rootKey & "\" & keys(i) & "\" & subKeys(J))
     
'変更（指摘部分） usbDevices.Add device.instanceID,device

'追加（連想配列(usbDevices)にFriendlyName情報とdevice.instanceIDをキーに、deviceを関連づけることの理解でよいのでしょうか？
'未設定のキー(key)に項目(item)を関連付けます。（キーが存在する場合はエラー）とネットで調べました。
'（キーが存在する場合はエラー）とはどういったことが考えられますか？

     usbDevices.Add device.name & "\" & device.instanceID,device
     
   Next
Next

'devicesKeyキーの配下にあるレジストリエントリの名前(値)の一覧が valuesに残る（配列を作ってくれる）
'末尾の「types」の部分が理解できません？ご教示願います
Reg.EnumValues HKEY_LOCAL_MACHINE, devicesKey, values, types

'valuesの最大値まで検索
For I=0 To UBound(values)

'データの種類が REG_BINARY である名前付きの値のためのデータ値を返します。とネットで調べました。
'また、GetBinaryValue メソッドは、成功の場合は 0、エラーが発生した場合はほかの値となる uint32 を返します。とネットで調べました。
'名前付きの値のためのデータ値を返しますとは、バイナリ値で返すのでしょうか？

   Reg.GetBinaryValue HKEY_LOCAL_MACHINE, devicesKey, values(I), binary
   strValue=""
  
'ここの回し方が、よく理解できていません。^^;
'step2で回すことは、１文字が16進(FF)表記だからでしょうか？
   For J = 0 To Ubound(binary) step 2
  
'ChrW 関数はUnicode 文字セットの文字を含む文字列型で返します。（とネットで調べました。）
'この部分をChrW(binary(J)+binary(J+1)*256)を分かりやすくご教示願います。
'ここがよく分かっていません。重点的にお願いします。
     strValue = strValue & ChrW(binary(J)+binary(J+1)*256)
   Next
  
'連想配列(usbDevices)のkeysの値の列挙はどこのソース部分で格納されたものなのでしょうか？
'usbDevices.keys内で列挙されている値は、usbDevices.Add device.name & "\" & device.instanceID,deviceの処理で列挙された値なののでしょか？
'また、.keysメソッドは連想配列のキーを（0から始まる）配列にして返します。（ネットで調べました）

   For Each key In usbDevices.keys
  
'変更（指摘部分）    If InStr(strValue,key) Then
'追加 InStr関数の検索条件（usbDevices(key).instanceID） 
     If InStr(strValue, usbDevices(key).instanceID) Then
        If InStr(values(I),"\DosDevices\") Then
'Hit時、\DosDevices\を""にリプレースする（ドライブレターをGET）
          usbDevices(key).lastDrive = Replace(values(I),"\DosDevices\","")
        Else
'接続されたUSB機器を記憶装置として認識し制御する汎用のドライバプログラムの値が、53f56307-b6bf-11d0-94f2-00a0c91efb8b及び
'53f5630d-b6bf-11d0-94f2-00a0c91efb8bと考えてよろしいのでしょうか？
          If InStr(strValue,"{53f56307-b6bf-11d0-94f2-00a0c91efb8b}") Or InStr(strValue,"{53f5630d-b6bf-11d0-94f2-00a0c91efb8b}") Then
             usbDevices(key).isStorageDevice=True
          Else
             usbDevices(key).isStorageDevice=False
          End If
        End If
     End If
   Next
Next
'usbDevices.keys内で列挙されている値は、usbDevices.Add device.name & "\" & device.instanceID,deviceの処理で列挙された値なのでしょか？
'また、.keysメソッドは連想配列のキーを（0から始まる）配列にして返します。（ネットで調べました）
For Each key In usbDevices.keys
     If usbDevices(key).isStorageDevice Then
        out=out & "name: " & usbDevices(key).name & vbCrLf & "instanceID: " & usbDevices(key).instanceID & vbcrlf & "lastDrive: " & usbDevices(key).lastDrive & vbCrLf & "Disk Stamp: " & usbDevices(key).diskStamp & vbCrLf & vbCrLf
     End If
Next

'テキスト出力
CreateObject("Scripting.FileSystemObject").CreateTextFile("out.txt").write out

Set Reg = Nothing
Set Service = Nothing
Set Locator = Nothing

Function GetRegTimeStamp(regKey)
   'レジストリキーからタイムスタンプを取得する処理を書く
   GetRegTimeStamp = ""
End Function

>Gowsu_na さん
instanceIDはユニーク（一意）の値だと思っていたのですが、実際はそうではないようで、キーの衝突が起こっていますね。

エラーが発生した行を
usbDevices.Add device.name & "\" & device.instanceID,device

If InStr(strValue,key) Then
という行を
If InStr(strValue, usbDevices(key).instanceID) Then

と直してください。これで衝突は起こらないはずです。
ちなみに連想配列に格納するキーが重複すると今回のようにエラーになってしまうので、重複の可能性がある場合はAddメソッドを呼ぶ前にExistsメソッドを使って連想配列にキーが存在しないことをチェックするのが定石です。
詳しくは
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh19/cformwsh19_02.html
をどうぞ。

>�@　Reg.EnumValues HKEY_LOCAL_MACHINE, devicesKey, values, types
devicesKeyキーの配下にあるレジストリエントリの名前の一覧がvaluesに配列として入ります。

>�@　以下のコード記述より、コメント行を記載して頂けたら、より理解でき
コメントと言ってもStdRegProvのメソッドとVBSの関数を普通に呼び出しているだけなので、これといってコメントすることがないのですが…。
分からない部分があればご説明します。
全体の流れとしては、

1.USBSTORキーに含まれているUSBデバイスの情報を取得
2.MountedDevicesキーに含まれているUSB接続情報（最後にどのドライブレターが付与されたか、それはUSB Mass Storageか否か）を取得
3.2で取得した接続情報をすべてチェックし、1で取得したデバイスがみつかったら、デバイスの情報に接続情報を追加する
4.デバイスの情報をテキストファイルにすべて出力

となります。

あと先ほどのご質問もそうですが、変数に何が入っているか分からないという場合はデバッガのステップ実行で値を追うとか、
デバッガは環境を用意するのが面倒なので単にMsgBoxでそのつど値を表示してやるとかするのが基本になりますね。

管理人牟田口大介 さん
早速のご回答ありがとうございます。
ご返答が遅れまして申し訳ありませんでした。^^;（ここ数日間、ネット環境がない場所にいました。）

早速ですが、頂いたスクリプトを実行しました。

usbDevices.Add device.instanceID,device

の部分でエラーとなり、

　このキーは既にコレクション内の要素に関連付けられています。

　コード：800A01C9

　ソース：Microsoft　VBSscript　実行時エラー

となります。

ADDメソッドで　device.instanceID,device　を・・・・

この部分が理解できていないので、ご教示頂けたら幸いです。

また、

�@　Reg.EnumValues HKEY_LOCAL_MACHINE, devicesKey, values, types

のvaluesに関する値は何が格納されるのでしょうか。

いろいろ言って申し訳ないのですが、

�@　以下のコード記述より、コメント行を記載して頂けたら、より理解でき

ると思いますので、よろしくお願いします。

DiskTimeStampの場所も頑張って見つけ出したいです。^^;

>Gowasu_na さん
書いてみました。
予想通り、かなりめんどくさいことになってしまいました^^;
USBデバイスの情報を格納するため簡単なクラスを作ったり、そのオブジェクトを連想配列（dictionary）に格納したりしてます。

USBSTORキーで得たインスタンスIDをMountedDevicesキーの値と突き合わせています。
レジストリのバイナリ値を読み込むのはGetBinaryValueメソッドを使います。
今回はこのバイナリの値を文字列として取得したいのですが、おそらくunicodeなので2バイトずつ取ってChrW関数にかけてやります。
これで得られた値に特定のGUIDが含まれていれば、それはUSB storageです。
またDosDevicesという文字列が名前に含まれているエントリの値にそのインスタンスIDがあれば、そこから最後に接続したドライブ名が取れます。
肝心のレジストリのタイムスタンプを取る処理がブランクになっていますが、ここにその処理を加えることができれば完成となるかと思います。



Class USBDevice
     Public instanceID
     Public name
     Public lastDrive
     Public isStorageDevice
     Public diskStamp
End Class

Set Locator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer(vbNullString, "root\default")
Set Reg = Service.Get("StdRegProv")
Set usbDevices=CreateObject("Scripting.Dictionary")
Const HKEY_LOCAL_MACHINE = &H80000002
rootKey = "SYSTEM\ControlSet001\Enum\USBSTOR"
devicesKey = "SYSTEM\MountedDevices"

Reg.EnumKey HKEY_LOCAL_MACHINE, rootKey, keys

For I=0 To UBound(keys)
     Reg.EnumKey HKEY_LOCAL_MACHINE, rootKey & "\" & keys(i), subKeys
     For J=0 To UBound(subKeys)
          Reg.GetStringValue HKEY_LOCAL_MACHINE,rootKey & "\" & keys(i) & "\" & subKeys(J), "FriendlyName", value
          Set device=New USBDevice
          device.instanceID=subKeys(J)
          device.name=value
          device.diskStamp=GetRegTimeStamp("HKEY_LOCAL_MACHINE\" & rootKey & "\" & keys(i) & "\" & subKeys(J))
          usbDevices.Add device.instanceID,device
     Next
Next

Reg.EnumValues HKEY_LOCAL_MACHINE, devicesKey, values, types

For I=0 To UBound(values)
     Reg.GetBinaryValue HKEY_LOCAL_MACHINE, devicesKey, values(I), binary
     strValue=""
     For J = 0 To Ubound(binary) step 2
          strValue = strValue & ChrW(binary(J)+binary(J+1)*256)
     Next
    
     For Each key In usbDevices.keys
          If InStr(strValue,key) Then
               If InStr(values(I),"\DosDevices\") Then
                    usbDevices(key).lastDrive = Replace(values(I),"\DosDevices\","")
               Else
                    If InStr(strValue,"{53f56307-b6bf-11d0-94f2-00a0c91efb8b}") Or InStr(strValue,"{53f5630d-b6bf-11d0-94f2-00a0c91efb8b}") Then
                         usbDevices(key).isStorageDevice=True
                    Else
                         usbDevices(key).isStorageDevice=False
                    End If
               End If
          End If
     Next
Next

For Each key In usbDevices.keys
          If usbDevices(key).isStorageDevice Then
               out=out & "name: " & usbDevices(key).name & vbCrLf & "instanceID: " & usbDevices(key).instanceID & vbcrlf & "lastDrive: " & usbDevices(key).lastDrive & vbCrLf & "Disk Stamp: " & usbDevices(key).diskStamp & vbCrLf & vbCrLf
          End If
Next
CreateObject("Scripting.FileSystemObject").CreateTextFile("out.txt").write out

Set Reg = Nothing
Set Service = Nothing
Set Locator = Nothing

Function GetRegTimeStamp(regKey)
     'レジストリキーからタイムスタンプを取得する処理を書く
     GetRegTimeStamp = ""
End Function

管理人牟田口大介 さん
早速のご回答ありがとうございます。
超感激です！！データ取得できました。（＾０＾）
分かりやすい解説ありがとうございました。

接続時のタイムスタンプの取得はまだわかりませんが、マウントしたときのデバイスドライブ名の場所が、レジスト内にあることが分かりました。
＜場所＞
HKEY_LOCAL_MACHINE\SYSYTEM\MounttedDevices内の\DosDevices\論理ドライブレターを発見しました。種類としては、REG_BINARYとあります。
　該当するドライブレター属性例（\DosDevices\I:）を開いて見ると、USBSTOR内の一意名のシリアルNo　→　dc44f2640266be&0　が存在しています。
　先ほど、USBSTOR内の一意名のシリアル値（サブキーの下にあるシリアルNOのキーをEnumKeyメソッドで取得）の値を検索条件として、（dc44f2640266be&0）で検索し、ドライブレター属性名（\DosDevices\I:）のI:の部分を取得し、FriendlyName名と結合して、
＜結果イメージ＞
（I:\→A-DATA USB Flash Drive USB Device）という具合にテキスト出力をしたいですが、バイナリ上をどのように検索して取得して結果を出力したらよいのでしょうか？
いろいろと言って申し訳ありません。きっかけでもわかれば幸いです。
よろしくお願いします。