フォルダの大きさ

質問

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

お礼

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