ウィンドウサイズ・場所のレジストリ位置

質問

マイドキュメントやマイコンピューターのウィンドウのサイズや位置を記憶して、変更した際にも元に戻せるようにしたいのですが何か方法はありますか？

その部分にかかわるレジストリを1台のマシンで記憶しておけば、他のマシンでも同じにできると考えたのですが、レジストリの場所がわかりません。
場所をご存知の方見えませんか？
(ひょっとしたらそんなのは無い？)

パソコン教室で複数の同じ型のマシンを使用していますが、生徒さんが操作した後いちいち手作業で直すのは大変です。

以前にも同じような質問をしたのですが・・思うような回答が得られなかったので言い方を変えて再度質問させていただきました。

回答No.17

ittochan · ベストアンサー

＞74行目　「見つかりませんでした」　80041002
ごめんなさい。
wmiのSINKはやめます

ではこれはどうでしょう？
お手数ですが、これを実行する前に、
一度フォルダオプションで「全フォルダのリセット」を
して
『マイドキュメント』、『マイコンピュータ』の
フォルダ設定をしておいてください。

const HKCU = &H80000001
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
dim StatusChk()
dim arrSubKeys
dim flag
Dim objTarget
dim FldrPath(100)
dim BackUpFile
dim ItmNo(100)
dim FolderCnt
BackUpFile = "FolderSetting_BackupFile.ini"

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("フォルダ設定をバックアップします" ,0,"ittochan",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
BackUpFile = f.ParentFolder & "\" & BackUpFile

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strBags="Software\Microsoft\Windows\ShellNoRoam\Bags\"
flag=0

set Shell = WScript.CreateObject("Shell.Application")
set WindowsShell = Shell.Windows
getfldr()
if FolderCnt>0 then
for i=0 to FolderCnt-1
closefldr()
next
end if
openfolder "shell:Personal"
openfolder "shell:DriveFolder"
getfldr()
Set MyFile = fso.CreateTextFile(BackUpFile, True)
MyFile.WriteLine 2
MyFile.WriteLine "shell:Personal"
MyFile.WriteLine "shell:DriveFolder"
GetSubKey()

ReDim StatusChk(UBound(arrSubKeys))

for k=0 to FolderCnt-1

Set objTarget = WindowsShell.item(ItmNo(k))

'Bagsキーからアドレスバーの状態を取得します。
on error resume next
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
StatusChk(i) = 2
Err.Clear
else
StatusChk(i) = inta
end if
next
on error goto 0

'アドレスバーの設定を反転させる
AddressBarChange()
WScript.Sleep 1000

objTarget.Navigate FldrPath(k)

'アドレスバーの設定が元に戻った場所を探す
on error resume next
do
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
inta = 2
Err.Clear
end if
if StatusChk(i) <> inta then
BagNo = arrSubKeys(i)
Exit Do
end if
next
loop while 1
on error goto 0

'アドレスバーの設定を元に戻す
AddressBarChange()

strKeyPath = strBags & BagNo & "\Shell"

oReg.EnumValues HKCU, strKeyPath, arrValueNames, arrValueTypes
MyFile.WriteLine UBound(arrValueNames)
For i=0 To UBound(arrValueNames)
strv = arrValueNames(i)
MyFile.WriteLine arrValueTypes(i)
MyFile.WriteLine strv
strKeyPath1 = "HKCU\" & strKeyPath & "\" & strv
Select Case arrValueTypes(i)
Case REG_SZ
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_EXPAND_SZ
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_BINARY
oReg.GetBinaryValue HKCU,strKeyPath ,strv,strValue
MyFile.WriteLine uBound(strValue)
For j = 0 to uBound(strValue)
MyFile.WriteLine strValue(j)
Next
Case REG_DWORD
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_MULTI_SZ
End Select
Next
next
getfldr()
for i=0 to FolderCnt-1
closefldr()
next
msgbox "終了しました"
MyFile.Close
WScript.Quit
sub getfldr()
dim i,j,k,obj
j=0
for i=0 to WindowsShell.Count-1
Set obj = WindowsShell.item(i)
if TypeName(obj)<>"Nothing" then
if InStr(obj.LocationURL,"file:///") = 1 then
ItmNo(j) = i
FldrPath(j) = obj.LocationURL
j=j+1
end if
end if
next
FolderCnt = j
end sub
sub closefldr()
dim i,obj
for i=0 to WindowsShell.Count-1
Set obj = WindowsShell.Item(i)
if TypeName(obj)<>"Nothing" then
if InStr(obj.LocationURL,"file:///")=1 then
pCnt = WindowsShell.Count
BusyCheck(obj)
obj.Quit
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
Exit for
end if
end if
next
end sub
sub GetSubKey()
oReg.EnumKey HKCU, strBags, arrSubKeys
end sub
sub openfolder(path)
pCnt = WindowsShell.Count
Shell.Open path
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
end sub
Sub AddressBarChange()
dim i
for i=0 to UBound(arrSubKeys)
if StatusChk(i)<>2 then
StatusChk(i) = not StatusChk(i)
WshShell.RegWrite "HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address" ,StatusChk(i),"REG_DWORD"
end if
next
End sub
sub BusyCheck(obj)
do
WScript.Sleep 100
loop while obj.Busy
end sub

お礼

返事が遅くなりました。
完璧ですね。
うまくいきました。
ありがとうございました。

補足

↓のお礼の補足です。

いろいろお手数をおかけしました。
本当に助かりました。

回答No.16

ittochan

そういえば、レジストリのバックアップは
HKEY_CURRENT_USERキー以下
だけでいいと思いますよ。

もちろんマシン別にね。

回答No.15

ittochan

リストア用スクリプトを修正しました。

const HKCU = &H80000001
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
dim StatusChk(), FldrPath(), arrValue()
dim arrSubKeys, flag, objTarget
dim BackUpFile, ItmNo, FolderCnt

BackUpFile = "FolderSetting_BackupFile.ini"

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("フォルダ設定を読み込みます" ,0,"ittochan",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
BackUpFile = f.ParentFolder & "\" & BackUpFile

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

strBags="Software\Microsoft\Windows\ShellNoRoam\Bags\"
flag=0

set Shell = WScript.CreateObject("Shell.Application")
set WindowsShell = Shell.Windows
redim ItmNo(WindowsShell.Count)
redim FldrPath(WindowsShell.Count)
if not fso.FileExists(BackUpFile) then
WScript.Echo "バックアップファイルがありません"
WScript.Quit
end if
Set MyFile = fso.OpenTextFile(BackUpFile)
FolderCnt = MyFile.ReadLine()

redim FldrPath(FolderCnt)

for i=0 to WindowsShell.Count-1
Set obj = WindowsShell.Item(i)
BusyCheck(obj)
if TypeName(obj)<>"Nothing" then
if InStr( obj.LocationURL , "file:///")=1 then
pCnt = WindowsShell.Count
obj.Quit
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
end if
end if
next

for i=0 to FolderCnt-1
FldrPath(i) = MyFile.ReadLine()
pCnt = WindowsShell.Count
Shell.Open FldrPath(k)
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
ItmNo = chckfldr()
WindowsShell.item(ItmNo).Quit
next

GetSubKey()
ReDim StatusChk(UBound(arrSubKeys))

for k=0 to FolderCnt-1
' if not fso.FolderExists( Replace(FldrPath(k),"file:///","") ) then k=k+1
' if k=FolderCnt then Exit for
' WScript.Echo FldrPath(k)
pCnt = WindowsShell.Count

Shell.Open FldrPath(k)

do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
ItmNo = chckfldr()
Set objTarget = WindowsShell.item(ItmNo)

'Bagsキーからアドレスバーの状態を取得します。
on error resume next
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
StatusChk(i) = 2
Err.Clear
else
StatusChk(i) = inta
end if
next
on error goto 0

'アドレスバーの設定を反転させる
StatusChange()
objTarget.Navigate "about:blank"
BusyCheck(objTarget)
objTarget.Navigate FldrPath(k)
BusyCheck(objTarget)
objTarget.Quit
flag=0
'アドレスバーの設定が元に戻った場所を探す
on error resume next
do while flag=0
WScript.Sleep 1000
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
inta = 2
Err.Clear
end if
if StatusChk(i) <> inta then
flag=1
BagNo = arrSubKeys(i)
Exit Do
end if
next
loop
on error goto 0

'アドレスバーの設定を元に戻す
StatusChange()
' WScript.Sleep 3000
if flag=1 then
strKeyPath = strBags & BagNo & "\Shell"
inta = MyFile.ReadLine()
For i=0 To inta
s = MyFile.ReadLine()
ValueType = CInt(s)
strv = MyFile.ReadLine()
strKeyPath1 = "HKCU\" & strKeyPath & "\" & strv
Select Case ValueType
Case REG_SZ
strValue = MyFile.ReadLine()
WshShell.RegWrite strKeyPath1,strValue,"REG_SZ"
Case REG_EXPAND_SZ
strValue = MyFile.ReadLine()
WshShell.RegWrite strKeyPath1,strValue,"REG_EXPAND_SZ"
Case REG_BINARY
intu = CInt( MyFile.ReadLine() )
redim arrValue(intu)
For j = 0 to intu
arrValue(j) = CInt( MyFile.ReadLine() )
Next
oReg.SetBinaryValue HKCU,strKeyPath ,strv,arrValue
Case REG_DWORD
intValue = CInt( MyFile.ReadLine() )
if strv<>"Rev" then
WshShell.RegWrite strKeyPath1,intValue,"REG_DWORD"
end if
Case REG_MULTI_SZ
End Select
Next
else
WshShell.Popup FldrPath(k) & "に失敗しました",0,"ittochan",16
end if
next
WScript.Echo "終了しました"
MyFile.Close
WScript.Quit
function chckfldr()
dim i,j
j=0
chckfldr = -1
for i=0 to WindowsShell.Count-1
Set obj = WindowsShell.item(i)
if TypeName(obj)<>"Nothing" then
BusyCheck(obj)
if instr(obj.LocationURL , "file:///")= 1 then
chckfldr = i
end if
end if
next
end function
sub GetSubKey()
oReg.EnumKey HKCU, strBags, arrSubKeys
end sub
Sub StatusChange()
for i=0 to UBound(arrSubKeys)
if StatusChk(i)<>2 then
StatusChk(i) = not StatusChk(i)
WshShell.RegWrite "HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address" ,StatusChk(i),"REG_DWORD"
end if
next
End sub
sub BusyCheck(obj)
do
WScript.Sleep 100
loop while obj.Busy
end sub

せっせ。・°°・_〆(・_・；)(；・_・)φ_・°°・。せっせ
どうでしょう？

お礼

こちらも、↑のバックアップでレストアするとばっちりです。

回答No.14

ittochan

＞■レストア：結果報告■こちらも
＞メッセージが表示されます。
了解しました。これはこちらのミスでした。

補足

バックアップのほうですが、Xpマシンでやってみると、
74行目　「見つかりませんでした」　80041002
・・・だそうです。

報告まで。

お手数かけます。申し訳ありません。

回答No.13

ittochan

＞(2000とMeで試してみました。)
試して駄目です。
XP専用です

補足

そ、そうなんですか！
XpとMeと2000といろいろあるので
つい、やってしまいました。

すいません。

回答No.12

ittochan

そしてこれがリストア用です

const HKCU = &H80000001
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
dim StatusChk(), FldrPath(), arrValue()
dim arrSubKeys, flag, objTarget
dim BackUpFile, ItmNo, FolderCnt

BackUpFile = "FolderSetting_BackupFile.ini"

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("フォルダ設定を読み込みます" ,0,"ittochan",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
BackUpFile = f.ParentFolder & "\" & BackUpFile

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

strBags="Software\Microsoft\Windows\ShellNoRoam\Bags\"
flag=0

set Shell = WScript.CreateObject("Shell.Application")
set WindowsShell = Shell.Windows
redim ItmNo(WindowsShell.Count)
redim FldrPath(WindowsShell.Count)
if not fso.FileExists(BackUpFile) then
WScript.Echo "バックアップファイルがありません"
WScript.Quit
end if
Set MyFile = fso.OpenTextFile(BackUpFile)
FolderCnt = MyFile.ReadLine()

redim FldrPath(FolderCnt)

for i=0 to FolderCnt-1
FldrPath(i) = MyFile.ReadLine()
pCnt = WindowsShell.Count
Shell.Open FldrPath(k)
do while pCnt = WindowsShell.Count
loop
ItmNo = chckfldr(FldrPath(i))
WindowsShell.item(ItmNo).Quit
next

GetSubKey()
ReDim StatusChk(UBound(arrSubKeys))

for k=0 to FolderCnt-1
' if not fso.FolderExists( Replace(FldrPath(k),"file:///","") ) then k=k+1
' if k=FolderCnt then Exit for
' WScript.Echo FldrPath(k)
pCnt = WindowsShell.Count

Shell.Open FldrPath(k)

do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
ItmNo = chckfldr(FldrPath(k))
Set objTarget = WindowsShell.item(ItmNo)

'Bagsキーからアドレスバーの状態を取得します。
on error resume next
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
StatusChk(i) = 2
Err.Clear
else
StatusChk(i) = inta
end if
next
on error goto 0

'アドレスバーの設定を反転させる
StatusChange()
objTarget.Navigate FldrPath(k)
BusyCheck(objTarget)
objTarget.Quit
flag=0
'アドレスバーの設定が元に戻った場所を探す
on error resume next
do while flag=0
WScript.Sleep 1000
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
inta = 2
Err.Clear
end if
if StatusChk(i) <> inta then
flag=1
BagNo = arrSubKeys(i)
Exit Do
end if
next
loop
on error goto 0

'アドレスバーの設定を元に戻す
StatusChange()
' WScript.Sleep 3000
if flag=1 then
strKeyPath = strBags & BagNo & "\Shell"
inta = MyFile.ReadLine()
For i=0 To inta
s = MyFile.ReadLine()
ValueType = CInt(s)
strv = MyFile.ReadLine()
strKeyPath1 = "HKCU\" & strKeyPath & "\" & strv
Select Case ValueType
Case REG_SZ
strValue = MyFile.ReadLine()
WshShell.RegWrite strKeyPath1,strValue,"REG_SZ"
Case REG_EXPAND_SZ
strValue = MyFile.ReadLine()
WshShell.RegWrite strKeyPath1,strValue,"REG_EXPAND_SZ"
Case REG_BINARY
intu = CInt( MyFile.ReadLine() )
redim arrValue(intu)
For j = 0 to intu
arrValue(j) = CInt( MyFile.ReadLine() )
Next
oReg.SetBinaryValue HKCU,strKeyPath ,strv,arrValue
Case REG_DWORD
intValue = CInt( MyFile.ReadLine() )
if strv<>"Rev" then
WshShell.RegWrite strKeyPath1,intValue,"REG_DWORD"
end if
Case REG_MULTI_SZ
End Select
Next
else
WshShell.Popup FldrPath(k) & "に失敗しました",0,"ittochan",16
end if
' Shell.Open FldrPath(k)
next
WScript.Echo "終了しました"
MyFile.Close
WScript.Quit
function chckfldr(FldrPath)
dim i,j
j=0
chckfldr = -1
for i=0 to WindowsShell.Count-1
if TypeName(WindowsShell.item(i))<>"Nothing" then
BusyCheck(WindowsShell.item(i))
if WindowsShell.item(i).LocationURL = FldrPath then
chckfldr = i
end if
end if
next
end function

sub GetSubKey()
oReg.EnumKey HKCU, strBags, arrSubKeys
end sub

Sub StatusChange()
for i=0 to UBound(arrSubKeys)
if StatusChk(i)<>2 then
StatusChk(i) = not StatusChk(i)
WshShell.RegWrite "HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address" ,StatusChk(i),"REG_DWORD"
end if
next
End sub
sub BusyCheck(obj)
do
WScript.Sleep 100
loop while obj.Busy
end sub

このスクリプトを
バックアップファイルと同じパスに置いて実行します。

回答No.11

ittochan

const HKCU = &H80000001
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
dim StatusChk()
dim arrSubKeys
dim flag
Dim objTarget
dim FldrPath(100)
dim BackUpFile
dim ItmNo(100)
dim FolderCnt
BackUpFile = "FolderSetting_BackupFile.ini"

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("フォルダ設定をバックアップします" ,0,"ittochan",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(WScript.ScriptFullName)
BackUpFile = f.ParentFolder & "\" & BackUpFile

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strBags="Software\Microsoft\Windows\ShellNoRoam\Bags\"
flag=0

set Shell = WScript.CreateObject("Shell.Application")
set WindowsShell = Shell.Windows
getfldr()
for i=0 to FolderCnt-1
closefldr(FldrPath(i))
next
openfolder "shell:Personal"
openfolder "shell:DriveFolder"
getfldr()
Set MyFile = fso.CreateTextFile(BackUpFile, True)
MyFile.WriteLine 2
MyFile.WriteLine "shell:Personal"
MyFile.WriteLine "shell:DriveFolder"
GetSubKey()

ReDim StatusChk(UBound(arrSubKeys))

for k=0 to FolderCnt-1

Set objTarget = WindowsShell.item(ItmNo(k))

'Bagsキーからアドレスバーの状態を取得します。
on error resume next
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
StatusChk(i) = 2
Err.Clear
else
StatusChk(i) = inta
end if
next
on error goto 0

'アドレスバーの設定を反転させる
AddressBarChange()

strHive = "HKEY_USERS"
strKeyPath = getSID() & "\\Software\\Microsoft\\Windows\\ShellNoRoam\\Bags"

Set wmiServices = GetObject("winmgmts:root/default")
Set wmiSink = WScript.CreateObject("WbemScripting.SWbemSink", "SINK_")
wmiServices.ExecNotificationQueryAsync wmiSink, _
"SELECT * FROM RegistryTreeChangeEvent WHERE Hive='" & strHive & "' AND " & _
"RootPath='" & strKeyPath & "'"

flag=0

objTarget.Navigate "about:blank"
BusyCheck objTarget
objTarget.Navigate FldrPath(k)
BusyCheck objTarget

While(flag=0)
WScript.Sleep 10000
WScript.Echo FldrPath(k) & "に失敗しました"
Set wmiSink = Noting
AddressBarChange()
WScript.Quit
Wend

'アドレスバーの設定が元に戻った場所を探す
on error resume next
for i=0 to UBound(arrSubKeys)
inta = WshShell.RegRead("HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address")
if Err.Number<>0 then
inta = 2
Err.Clear
end if
if StatusChk(i) <> inta then
BagNo = arrSubKeys(i)
Exit For
end if
next
on error goto 0

'アドレスバーの設定を元に戻す
AddressBarChange()

strKeyPath = strBags & BagNo & "\Shell"

oReg.EnumValues HKCU, strKeyPath, arrValueNames, arrValueTypes
MyFile.WriteLine UBound(arrValueNames)
For i=0 To UBound(arrValueNames)
strv = arrValueNames(i)
MyFile.WriteLine arrValueTypes(i)
MyFile.WriteLine strv
strKeyPath1 = "HKCU\" & strKeyPath & "\" & strv
Select Case arrValueTypes(i)
Case REG_SZ
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_EXPAND_SZ
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_BINARY
oReg.GetBinaryValue HKCU,strKeyPath ,strv,strValue
MyFile.WriteLine uBound(strValue)
For j = 0 to uBound(strValue)
MyFile.WriteLine strValue(j)
Next
Case REG_DWORD
MyFile.WriteLine WshShell.RegRead( strKeyPath1 )
Case REG_MULTI_SZ
End Select
Next
next
getfldr()
for i=0 to FolderCnt-1
closefldr(FldrPath(i))
next
msgbox "終了しました"
MyFile.Close
WScript.Quit
sub getfldr()
dim i,j,k
j=0
for i=0 to WindowsShell.Count-1
BusyCheck(WindowsShell.item(i))
if TypeName(WindowsShell.item(i))<>"Nothing" then
if InStr(WindowsShell.item(i).LocationURL,"file") = 1 then
ItmNo(j) = i
FldrPath(j) = WindowsShell.item(i).LocationURL
j=j+1
end if
end if
next
FolderCnt = j
end sub
sub closefldr(path)
dim i,obj
for i=0 to WindowsShell.Count-1
Set obj = WindowsShell.Item(i)
BusyCheck(obj)
if TypeName(obj)<>"Nothing" then
if obj.LocationURL = path then
pCnt = WindowsShell.Count
obj.Quit
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
Exit for
end if
end if
next
end sub
sub GetSubKey()
oReg.EnumKey HKCU, strBags, arrSubKeys
end sub
sub openfolder(path)
pCnt = WindowsShell.Count
Shell.Open path
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
end sub
Sub AddressBarChange()
for i=0 to UBound(arrSubKeys)
if StatusChk(i)<>2 then
StatusChk(i) = not StatusChk(i)
WshShell.RegWrite "HKCU\" & strBags & arrSubKeys(i) & "\Shell\Address" ,StatusChk(i),"REG_DWORD"
end if
next
End sub
sub BusyCheck(obj)
do
WScript.Sleep 100
loop while obj.Busy
end sub

Sub SINK_OnObjectReady(wmiObject, wmiAsyncContext)
flag=1
End Sub
function getSID()
Set objWMIService = GetObject("winmgmts:root\cimv2")
Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objItem in colProcess
if objItem.Caption = "explorer.exe" then
objItem.GetOwnerSid getSID
end if
Next
Set colProcess = Nothing
Set objWMIService = Nothing
end function

実行するとスクリプトと同じパスにバックアップファイルが作成されるので
メモ帳で開いて確認してみてください。

汎用性を持たせたいんですが
マイドキュメントのパスがユーザー毎に違うので
困っています。

補足

ながーいスクリプト、すいません。ありがとうございます。
やってみました。
■バックアップ：結果報告■こちらではうまくいきません。
・OSに依存するのでしょうか？(2000とMeで試してみました。)
・バックアップのときに　47行目で「型が一致しません：'UBound'」エラー
　コード：800A000D

・・・という表示になります。

■レストア：結果報告■こちらもメッセージが表示されます。
・49行目 「オブジェクトがありません：'WindowsShell.item（..）'」
　コード800A01A8

・・・・だそうです。

回答No.10

ittochan

＞これはVBSですか？
そうです。

＞できるのですか？
出来ました。
今調整中です。ヾ(>▽<)ゞ

回答No.9

ittochan

今頃補足の回答です``r(・_・；)

＞「全フォルダをリセット」やってみましたが、
＞サイズ、位置が戻りません。
そうです。
Windowsの規定値に戻っちゃうからです。

スクリプトが出来そうです。
待っててねp(*・o・*)q

補足

期待してます。m(__)m

回答No.8

ittochan

任意のフォルダの設定なら
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags
キーをいじることになります。

このサブキーの数字はフォルダに対応していて
「全フォルダのリセット」後
開いた順番に増えていきます。
すべてのマシンで違います。

どの番号がどのフォルダに対応しているかは
スクリプトで判明可能です。

＞マイドキュメントやマイコンピューターの
＞ウィンドウのサイズや位置を記憶して
個人的に興味があるので、スクリプトを作成してもいいです(o゜▽゜)o

こんなのです↓

参考URL：

http://www.okweb.ne.jp/kotaeru.php3?q=537261

補足

話がすごい方向に・・・・
これはVBSですか？
できるのですか？
マイドキュメントとマイコンピューターです。

回答No.7

ittochan

検証してみました。
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\StreamMRU
と
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Streams
と
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\BagMRU
と
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags
でした。

同じマシンだけのようです。

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Streams
と
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags
だけでも反映されました

構成が違う(ドライブ)マシンだと駄目でした。
同じ構成ならいけるかもしれませんが
マシン毎にバックアップするのがいいでしょう。

これらのキーをバックアップしておき
リストア(自己責任で)したら
Explorer.exeプロセスを再起動(自己責任で)させます。

↑よりもANo.#3の方法が安全で
マシン毎にバックアップせずに済みます。

スクリプトを作る事になります
デスクトップに保存したいフォルダウィンドウを複数開いておいて
設定をバックアップするっていうのはどうでしょうか？
スクリプトを作る側としてはこの方が楽です

それとも設定したいフォルダ数が多すぎますか？
テキストファイルにフォルダのリストを作成しておくっていうのがいいでしょうか？

お礼

ありがとうございます。
会社で試してみました。
ここのマシンはMeと2000とXpがあるのですが、
Meと2000については↓しかありません。
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Streams

↑のバックアップレストアの結果ですが、概ね良好です。
完全に同じではなく、やはりマシンごと多少位置が違ったりはあるようですが、いいようです。
もう少し研究してみます。
本当にありがとうございました。

補足

>HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Streams
>HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags

↑いけそうですね。
マシンはまったく同じ機種でIPとか コンピューター名画違うだけなので、いけそうです。
今、家のマシンで見てみましたが、明日会社でやって見ます。
土曜も出勤。　(ーー゛)