フォルダの大きさ

質問

WindowsXPHome SP1です。
新しいフォルダを作り開くとフォルダサイズが画面いっぱいに伸びた状態で開きたいのですが画面いっぱいになって開きません。
画面いっぱいに伸ばしてから閉じてもう一度開けば問題ないのですがすべてのフォルダの初期フォルダの大きさを変更することはできないでしょうか？

回答No.9

ittochan · ベストアンサー

＞エラー:オブジェクトがありまん。
＞:'WindowsShell.item(....)'
これ、たまにでたんですよね。

これはどうでしょう？

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 Input
Dim obj
Dim objTarget
dim FldrPath

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("「すべてのフォルダに適用」をします(ウィンドウサイズも含む)" ,0,"Windows Script Host",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

WScript.Echo "基準にしたいフォルダを１つだけ開いてください"

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

ItmNo = chckfldr()
WindowsShell.item(ItmNo).Quit
Shell.Open FldrPath
ItmNo = chckfldr()
Set objTarget = WindowsShell.item(ItmNo)

GetSubKey()

'Bagsキーからアドレスバーの状態を取得します。
ReDim StatusChk(UBound(arrSubKeys))
for i=0 to UBound(arrSubKeys)
oReg.GetDWORDValue HKCU,strBags & arrSubKeys(i) & "\Shell" ,"Address" , inta
if TypeName(inta)="Null" then
StatusChk(i) = 2
else
StatusChk(i) = inta
end if
next

'アドレスバーの設定を反転させる
StatusChange()
objTarget.Navigate FldrPath
BusyCheck objTarget
flag=0
'アドレスバーの設定が元に戻った場所を探す
for i=0 to UBound(arrSubKeys)
oReg.GetDWORDValue HKCU,strBags & arrSubKeys(i) & "\Shell" ,"Address" ,inta
if TypeName(inta)="Null" then
inta = 2
end if
if StatusChk(i) <> inta then
flag=1
BagNo = arrSubKeys(i)
Exit For
end if
next

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

if flag=1 then

strKeyPath = strBags & BagNo & "\Shell"
AllFolderKeyPath = strBags & "AllFolders\Shell"

oReg.DeleteKey HKCU,AllFolderKeyPath
oReg.CreateKey HKCU,AllFolderKeyPath

oReg.EnumValues HKCU, strKeyPath, arrValueNames, arrValueTypes
For i=0 To UBound(arrValueNames)
for j=0 to UBound(arrSubKeys)
strv = arrValueNames(i)
if j<>BagNo then
strKeyPath1 = "HKCU\" & strKeyPath & "\" & strv
strKeyPath2 = strBags & arrSubKeys(j) & "\Shell"
strKeyPath3 = "HKCU\" & strKeyPath2 & "\" & strv
strKeyPath4 = "HKCU\" & AllFolderKeyPath & "\" & strv
Select Case arrValueTypes(i)
Case REG_SZ
stra = WshShell.RegRead( strKeyPath1 )
if strv<>"FolderType" then
WshShell.RegWrite strKeyPath3,stra,"REG_SZ"
WshShell.RegWrite strKeyPath4,stra,"REG_SZ"
end if
Case REG_EXPAND_SZ
stra = WshShell.RegRead( strKeyPath1 )
WshShell.RegWrite strKeyPath3,stra,"REG_EXPAND_SZ"
WshShell.RegWrite strKeyPath4,stra,"REG_EXPAND_SZ"
Case REG_BINARY
oReg.GetBinaryValue HKCU,strKeyPath ,strv,strValue
oReg.SetBinaryValue HKCU,strKeyPath2 ,strv,strValue
oReg.SetBinaryValue HKCU,AllFolderKeyPath ,strv,strValue
Case REG_DWORD
inta = WshShell.RegRead( strKeyPath1 )
WshShell.RegWrite strKeyPath3,inta,"REG_DWORD"
WshShell.RegWrite strKeyPath4,inta,"REG_DWORD"
Case REG_MULTI_SZ
End Select
end if
next
Next
WshShell.Popup "成功しました",0,"Windows Script Host",64
else
WshShell.Popup "失敗しました",0,"Windows Script Host",16
end if

function chckfldr()
dim i,j,k
j=0
k=0
chckfldr = -1
do
for i=0 to WindowsShell.Count-1
BusyCheck(WindowsShell.item(i))
if TypeName(WindowsShell.item(i))<>"Nothing" then
FldrPath = WindowsShell.item(i).LocationURL
if InStr(FldrPath,"file") = 1 then
if j=1 then
WScript.Echo "フォルダが複数開いているので中止します"
WScript.Quit
end if
chckfldr = i
j=1
end if
end if
next
k=k+1
WScript.Sleep 100
if k>600 then
msgbox "Explorerの再起動に失敗しました"
WScript.Quit
end if
loop while chckfldr = -1
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 FolderClose()
pCnt = WindowsShell.Count
WindowsShell.item(ItmNo).Quit
do while pCnt = WindowsShell.Count
WScript.Sleep 100
loop
end sub
sub FolderOpen()
Set obj = WshShell.Exec("explorer " & FldrPath )
do while pCnt <> WindowsShell.Count
WScript.Sleep 100
loop
ItmNo = chckfldr()
Set objTarget = WindowsShell.item(ItmNo)
end sub
sub BusyCheck(obj)
do
WScript.Sleep 100
loop while obj.Busy
end sub

お礼

ありがとうございます。
今度は正しく適用されたようです
ところで変更された点はステータスバーですか？
しばらく使用して問題が無ければ締め切らせていただきます。
ありがとうございました。

回答No.8

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,key2
Dim Input

Set WshShell = WScript.CreateObject("WScript.Shell")
i = WshShell.PopUp("「すべてのフォルダに適用」をします(ウィンドウサイズも含む)" ,0,"Windows Script Host",65)
if i<>1 then
WScript.Echo "中止しました"
WScript.Quit
end if

WScript.Echo "基準にしたいフォルダを１つだけ開いてください"

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

strBags="Software\Microsoft\Windows\ShellNoRoam\Bags\"
key2="\Shell\Status"
flag=0
set Shell = CreateObject("Shell.Application")
set WindowsShell = Shell.Windows

FldrPath =""

ItmNo = chckfldr()
WindowsShell.item(ItmNo).Quit
Set obj = WshShell.Exec("explorer " & FldrPath )
ItmNo = chckfldr()
do while ItmNo = -1
WScript.Sleep 100
ItmNo = chckfldr()
loop

Set objTarget = WindowsShell.item(ItmNo)

do while objTarget.Busy
WScript.Sleep 100
loop
'WScript.Sleep 1000

GetSubKey()

ReDim StatusChk(UBound(arrSubKeys))
for i=0 to UBound(arrSubKeys)
oReg.GetDWORDValue HKCU,strBags & arrSubKeys(i) & "\Shell" ,"Status" , inta
StatusChk(i) = inta
next

StatusChange()

MovePath "shell:DriveFolder" , True
WScript.Sleep 1000
for i=0 to UBound(arrSubKeys)
oReg.GetDWORDValue HKCU,strBags & arrSubKeys(i) & "\Shell" ,"Status" ,inta
if StatusChk(i) <> inta then
flag=1
Exit For
end if
next

StatusChange()

MovePath FldrPath , True

if flag=1 then
BagNo = i

strKeyPath = strBags & arrSubKeys(BagNo) & "\Shell"
AllFolderKeyPath = strBags & "AllFolders\Shell"

oReg.EnumValues HKCU, strKeyPath, arrValueNames, arrValueTypes
oReg.CreateKey HKCU,AllFolderKeyPath
For i=0 To UBound(arrValueNames)
for j=0 to UBound(arrSubKeys)
strv = arrValueNames(i)
if j<>BagNo then
strKeyPath2 = strBags & arrSubKeys(j) & "\Shell"
Select Case arrValueTypes(i)
Case REG_SZ
stra = WshShell.RegRead( "HKCU\" & strKeyPath & "\" & strv )
if strv<>"FolderType" then
WshShell.RegWrite "HKCU\" & strKeyPath2 & "\" & strv,stra,"REG_SZ"
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & strv,stra,"REG_SZ"
end if
Case REG_EXPAND_SZ
stra = WshShell.RegRead( "HKCU\" & strKeyPath & "\" & strv )
WshShell.RegWrite "HKCU\" & strKeyPath2 & "\" & strv,stra,"REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & strv,stra,"REG_EXPAND_SZ"
Case REG_BINARY
oReg.GetBinaryValue HKCU,strKeyPath ,strv,strValue
oReg.SetBinaryValue HKCU,strKeyPath2 ,strv,strValue
oReg.SetBinaryValue HKCU,AllFolderKeyPath ,strv,strValue
Case REG_DWORD
inta = WshShell.RegRead( "HKCU\" & strKeyPath & "\" & strv )
WshShell.RegWrite "HKCU\" & strKeyPath2 & "\" & strv,inta,"REG_DWORD"
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & strv,inta,"REG_DWORD"
Case REG_MULTI_SZ
End Select
end if
next
Next
WshShell.Popup "成功しました",0,"Windows Script Host",64
else
WshShell.Popup "失敗しました",0,"Windows Script Host",16
end if

function chckfldr()
j=0
chckfldr = -1
for i=0 to WindowsShell.Count-1
if TypeName(WindowsShell.item(i))<>"Nothing" then
FldrPath = WindowsShell.item(i).LocationURL
if InStr(FldrPath,"file") = 1 then
if j=1 then
WScript.Echo "フォルダが複数開いているので中止します"
WScript.Quit
end if
chckfldr = i
j=1
end if
end if
next
end function

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

sub MovePath(str,flag)
objTarget.Navigate str
if flag then
do
WScript.Sleep 100
loop while objTarget.Busy
end if
end sub
Sub StatusChange()
WshShell.AppActivate obj.ProcessID
WScript.Sleep 100
WshShell.sendkeys "%vb"
End sub

お礼

ありがとうございます。
やってみたところフォルダを開いてくださいの後にエラーが発生しました。
スクリプト: C:\Documents and Settingd\ユーザー名デスクトップ\フォルダ.vbs
行：32
文字：1
エラー:オブジェクトがありません。:'WindowsShell.item(....)'
コード:800A01A8
ソース:Microsoft VBSScript 実行時エラー

補足

お礼の欄にユーザー名デスクトップとなっていますがユーザー名\デスクトップの間違いです。

回答No.7

ittochan

できました。ヾ(;´▽｀A

---この下から
const HKEY_CURRENT_USER = &H80000001
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7

set WshShell = WScript.CreateObject("WScript.Shell")
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
set objArgs = WScript.Arguments

WScript.Echo "基準にしたいフォルダを１つだけ開いてください"

dim StatusChk(1000)
dim arrSubKeys
dim flag,key1,key2
Dim Input

key1="HKCU\Software\Microsoft\Windows\ShellNoRoam\Bags\"
key2="\Shell\Status"
flag=0
set Shell = CreateObject("Shell.Application")
set WindowsShell = Shell.Windows

FldrPath =""

ItmNo = chckfldr()

do while ItmNo = -1
WScript.Sleep 100
ItmNo = chckfldr()
loop

Set objTarget = WindowsShell.item(ItmNo)

do while objTarget.Busy
WScript.Sleep 100
loop

MovePath FldrPath , True

GetSubKey()

On Error Resume Next

for i=0 to UBound(arrSubKeys)
StatusChk(i) = WshShell.RegRead(key1 + arrSubKeys(i) + key2)
if Err.Number<>0 then
StatusChk(i) = 0
Err.Clear
end if
next

StatusChange()

MovePath "shell:DriveFolder" , True

WScript.Sleep 1000

for i=0 to UBound(arrSubKeys)
if StatusChk(i) <> WshShell.RegRead(key1 + arrSubKeys(i) + key2) then
if Err.Number=0 then
flag=1
Exit For
end if
Err.Clear
end if
next
on error goto 0

StatusChange()
MovePath FldrPath , True

if flag=1 then
BagNo = i
i = WshShell.PopUp("保存されているウィンドウ設定も最大化にしますか？" ,0,"Windows Script Host",36)
if i=6 then
for j=0 to UBound(arrSubKeys)
WshShell.RegWrite key1 & arrSubKeys(j) & "\Shell\ShowCmd" , &H3 , "REG_DWORD"
WshShell.RegWrite key1 & arrSubKeys(j) & "\Shell\WFlags" , &H2 , "REG_DWORD"
next
end if

strBags = "Software\Microsoft\Windows\ShellNoRoam\Bags"
strKeyPath = strBags & "\" & arrSubKeys(BagNo) & "\Shell"
AllFolderKeyPath = strBags & "\AllFolders\Shell"

oReg.EnumValues HKEY_CURRENT_USER, strKeyPath,_
arrValueNames, arrValueTypes

For i=0 To UBound(arrValueNames)
Select Case arrValueTypes(i)
Case REG_SZ
stra = WshShell.RegRead("HKCU\" & strKeyPath & "\" & arrValueNames(i))
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & arrValueNames(i),stra,"REG_SZ"
Case REG_EXPAND_SZ
stra = WshShell.RegRead("HKCU\" & strKeyPath & "\" & arrValueNames(i))
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & arrValueNames(i),stra,"REG_EXPAND_SZ"
Case REG_BINARY
oReg.GetBinaryValue HKEY_CURRENT_USER,strKeyPath ,_
arrValueNames(i),strValue
oReg.SetBinaryValue HKEY_CURRENT_USER,AllFolderKeyPath ,_
arrValueNames(i),strValue
Case REG_DWORD
inta = WshShell.RegRead("HKCU\" & strKeyPath & "\" & arrValueNames(i))
WshShell.RegWrite "HKCU\" & AllFolderKeyPath & "\" & arrValueNames(i),inta,"REG_DWORD"
Case REG_MULTI_SZ
End Select
Next
BtnCode = WshShell.Popup("成功しました",0,"Windows Script Host",16)
else
BtnCode = WshShell.Popup("失敗しました",0,"Windows Script Host",16)
end if

function chckfldr()
for i=0 to WindowsShell.Count-1
if TypeName(WindowsShell.item(i))<>"Nothing" then
FldrPath = WindowsShell.item(i).LocationURL
if InStr(FldrPath,"file") = 1 then
chckfldr = i
exit function
end if
end if
next
chckfldr = -1
end function

function GetSubKey()
const HKEY_CURRENT_USER = &H80000001
strKeyPath = "Software\Microsoft\Windows\ShellNoRoam\Bags"
oReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubKeys
end function

sub MovePath(str,flag)
objTarget.Navigate str
if flag then
do
WScript.Sleep 100
loop while objTarget.Busy
end if
end sub

Sub StatusChange()
WScript.Sleep 100
WshShell.sendkeys "%vb"
End sub
----この上まで

エクスプローラは新規のフォルダを開くときに
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags\AllFolders\Shell
このキーを見るんですが
現在のところこのキーは使われてないみたいです。
↑のスクリプトで基準となるフォルダから、このキーへ、フォルダ設定をコピーしています

今まで開いたことがあるフォルダのサイズも最大化に設定できます

フォルダのタスクもコピーするので
タスクが「画像」になっているフォルダを基準にすると
新規のフォルダのタスクも「画像」になります。
しかし、
削除したフォルダと同じ名前のフォルダを新規に作成した場合
タスクは継承されません。(レジストリに記録されているので）

フォルダオプションの
「すべてのフォルダに適用」か「全フォルダをリセット」をクリックすると
元に戻ります。
もしくは
HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags\AllFolders
このキーを削除しても結構です。

お礼

ありがとうございます。
Homeでもできたようです。
非常に助かりました。ありがとうございました。

しばらく使用してみて問題が無ければ締め切らせていただきます。

回答No.6

ittochan

出来るようです。
暫くお待ちください
(XP Proです。Homeは未確認ですが多分大丈夫かな？）

お礼

ありがとうございます。
↓のVBSを使わせていただきました。

回答No.5

ittochan

作成してみたんですが無理みたいでした。

通常、ダブルクリックで「開く」で
フォルダが開くんですが、
これをスクリプトで中継させるのは
私の勉強不足で駄目でした。

新しいコマンドを作成し
右クリックから
「最大化で開く」を選択します
フォルダ内でフォルダを開くときは必ず新しいウィンドウが起動します。

これでは実用に耐えられません。

一応書いたスクリプトを書きます

Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
SystemPath = WshShell.ExpandEnvironmentStrings("%windir%")
ProgramFilesPath = WshShell.ExpandEnvironmentStrings("%programfiles%")
i = WshShell.PopUp("未設定のフォルダのウィンドウサイズを最大化させますか？　[いいえ]をクリックすると元に戻します",0,"Windows Script Host",35)
if i=6 then
WshShell.RegWrite "HKCR\Folder\shell\maxopen\","最大化で開く","REG_SZ"
WshShell.RegWrite "HKCR\Folder\shell\maxopen\command\","wscript " & SystemPath & "\OpenNewFolder.vbs " & chr(34) & "%1" & chr(34),"REG_SZ"
WshShell.RegWrite "HKCR\Folder\shell\","open" ,"REG_SZ"
set f = fso.OpenTextFile(SystemPath & "\OpenNewFolder.vbs",2,true)

f.WriteLine "Set WshShell = CreateObject(" & chr(34) & "WScript.Shell" & chr(34) & ")"
f.WriteLine "set objArgs = WScript.Arguments"
f.WriteLine "set Shell = CreateObject(" & chr(34) & "Shell.Application" & chr(34) & ")"
f.WriteLine "set WindowsShell = Shell.Windows"
f.WriteLine "pCnt = WindowsShell.Count"
f.WriteLine "Set obj = WshShell.Exec(" & chr(34) & ProgramFilesPath & "\Internet Explorer\IEXPLORE.EXE " & chr(34) & " & chr(34) & objArgs(0) & chr(34)" & ")"
f.WriteLine "do while pCnt=WindowsShell.Count"
f.WriteLine " WScript.Sleep 100"
f.WriteLine "loop"
f.WriteLine "do while WindowsShell.item(pCnt).Busy"
f.WriteLine " WScript.Sleep 100"
f.WriteLine "loop"
f.WriteLine "WshShell.AppActivate(obj.ProcessID)"
f.WriteLine "WshShell.Sendkeys " & chr(34) & "% x" & chr(34)
f.close
msgbox("完了しました")
elseif i=7 then
fso.DeleteFile SystemPath & "\OpenNewFolder.vbs"
WshShell.RegDelete "HKCR\Folder\shell\maxopen\command\"
WshShell.RegDelete "HKCR\Folder\shell\maxopen\"
WshShell.RegWrite "HKCR\Folder\shell\","","REG_SZ"
end if

このvbsファイルをダブルクリックして
「はい」をクリックすると
右クリックメニューに「最大化で開く」が追加されます

「いいえ」をクリックすると
追加したメニューを削除します。

回答No.4

ittochan

＞開いたウィンドウを閉じても
＞そのウィンドウの画像が残っているという感じです。
なるほど、変ですね。

違う方法を考えて見ます

普通
最大化しているフォルダウィンドウにあるフォルダを
開けば同じウィンドウで開くので問題無いのですが
デスクトップに新規フォルダを開くときは
最大化になりませんね。

今まで開いたことがあるフォルダのウィンドウ情報は
「全フォルダのリセット」をしない限り記憶されていて
その情報を書き換えることにより最大化は可能なんですが
新規フォルダはウィンドウサイズが保存されていないので既定のExplorerのウィンドウサイズで開かれてしまいます。
Explorer.exeの起動オプションには
最大化のコマンドは存在していません。

今のところ出来ることで考えられるのは

レジストリの

マイコンピュータ
　＋HKEY_CLASSES_ROOT
　　＋Folder
　　　＋shell
　　　　＋open
　　　　　＋command ←クリック
右ウィンドウの
名前＿＿＿＿種類＿＿＿＿＿＿データ
(既定)　REG_EXPAND_SZ　　%SystemRoot%\Explorer.exe /idlist,%I,%L
このデータを書き換えて
スクリプトからExplorerを起動させて
最大化のコマンドを送信することでしょうか。

作ってみます。
期待しないで待っててね

回答No.3

ittochan

＞正常にWindowsが操作
正確にはどのような症状だったのでしょうか？
私のでは異常は確認できませんでした。

補足

開いたウィンドウを閉じてもそのウィンドウの画像が残っているという感じです。

回答No.2

ittochan

＞フォルダの初期フォルダの大きさを変更することはできないでしょうか？
WindowsXP Pro Sp1では↓で
フォルダはもとよりほとんど全てのウィンドウが常に最大化になるんです
(ノ゜ο゜)ノ

スタート→「ファイル名を指定して実行」をクリック。
regedit と入力して、「ＯＫ」をクリック。

レジストリエディタが起動されます。
以下のように潜っていきます。

マイコンピュータ
　＋HKEY_CURRENT_USER
　　＋Software
　　　＋Microsoft
　　　　＋Windows
　　　　　＋CurrentVersion
　　　　　　＋Explorer ←クリック
右側のウインドウで右クリック→「新規」→「DWORD値」をクリック

「新しい値 #1」を「MaximizeApps」に変更します。

「MaximizeApps」をダブルクリック
「値のデータ」に 1 を入力して「enter」を押します。

名前＿＿＿＿＿＿種類＿＿＿＿データ
MaximizeApps　REG_DWORD　0x00000001(1)
こうなればOKです
レジストリエディタを閉じて完了です。

お試しください。
p(*・o・*)q

補足

ありがとうございます。
やってみたところウィンドウは正常に大きくなりましたが、正常にWindowsが操作できなくなったため元に戻しました。

回答No.1

PAPA0427

エクスプローラーのショートカットのプロパティで、「ショートカット」タブ、「実行時大きさ」を最大を選べば出来るはずです。