- Joined
- Feb 18, 2002
This guy here http://home.mchsi.com/~k.miller79/
made the script below for Windows XP. It sets folder view preference for a folder and then has those details applied to all its subfolders but not system wide.
So let's say you have a folder with a huge number of subfolders all of which you'd like displayed as a List, this script allows you to do that under Windows XP.
For whatever reason he hasn't made a script for Windows Vista, can this be done for Vista?
made the script below for Windows XP. It sets folder view preference for a folder and then has those details applied to all its subfolders but not system wide.
So let's say you have a folder with a huge number of subfolders all of which you'd like displayed as a List, this script allows you to do that under Windows XP.
For whatever reason he hasn't made a script for Windows Vista, can this be done for Vista?
Code:
'************************************************
' Folder View Master *
' v3.1 *
' © Keith Miller *
'************************************************
Const conBagMRUKey = "HKCU\Software\Microsoft\Windows\ShellNoRoam\BagMRU"
Const conBagsKey = "HKCU\Software\Microsoft\Windows\ShellNoRoam\Bags"
Const conAllFolders = "HKCU\Software\Microsoft\Windows\ShellNoRoam\Bags\AllFolders"
Const conViewLimitValue = "HKCU\Software\Microsoft\Windows\ShellNoRoam\BagMRU Size"
Const conMaxBags = 8000
Const conUndoFile = "Undo.reg"
dim oXpShell, oWshShell, oFso, oRegistry, oFolder, oFolderInfo
dim BlockedByNSPath, BlockedByMRUKey, SavedByNSPath, SavedByMRUKey
dim ForbiddenByNSPath
dim sScriptTitle, sScriptPath, sWorkingPath, sAntiVirusMsg, sIntroMsg, sIntro2
dim sNotReady, sMaxLimitMsg, sFreshStart,sPerFolder, sForbiddenMsg, sSetViewPrompt
dim sPreservePrompt, sBlockPrompt, sMsg, sRestartMsg, sThanksTitle, sThanksMsg
dim bRestart, bOpenIsDefault, bFreshStart, bPreserveViews, bPerFolderPrompt
dim tsLog
class FolderInfo
public BagNumber, MRUKey
end class
sAntiVirusMsg = "In order to function, this script must modify the registry and " _
& "create & delete files. These actions will generate an alert from most " _
& "anti-virus software. This is normal. Do not be alarmed." & vbCrLf & vbCrLf _
& "Do you wish to continue?"
If (MsgBox(sAntiVirusMsg, vbYesNo, "Welcome!") <> vbYes) Then
WScript.Quit
End If
'Assign objects
Set oXpShell = CreateObject("Shell.Application")
Set oWshShell = CreateObject("WScript.Shell")
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set BlockedByNSPath = createobject("scripting.dictionary")
Set BlockedByMRUKey = createobject("scripting.dictionary")
Set SavedByNSPath = createobject("scripting.dictionary")
Set SavedByMRUKey = createobject("scripting.dictionary")
Set ForbiddenByNSPath = createobject("scripting.dictionary")
InitStrings
oFso.CreateFolder(sWorkingPath)
InitLog
'*** Can't Proceed if 'NoSaveSettings' policy is in effect
bRestart = CheckSavePolicy
If bRestart Then
MsgBox sRestartMsg
WScript.Quit
End If
'*** Instructions & Warnings ***
If (MsgBox(sIntroMsg, vbYesNo, sScriptTitle) <> vbYes) Then
WScript.Quit
End If
If (MsgBox(sIntro2, vbYesNo + vbExclamation, sScriptTitle) <> vbYes) Then
WScript.Quit
End If
'*** Verify other windows are closed ***
Do While GetExplorerWindowCount <> 0
If (MsgBox(GetExplorerWindowCount & sNotReady, _
vbRetryCancel + vbCritical, sScriptTitle) <> vbReTry) Then
WScript.Quit
End If
Loop
CreateUndoFile
If (GetViewLimit() < conMaxBags) Then OfferMaxLimit()
bFreshStart = OfferFreshStart()
bPerFolderPrompt = False
If Not bFreshStart Then
bPerFolderPrompt = OfferPerFolderOption()
End If
InitForbiddenList
bOpenIsDefault = IsOpenDefault()
bContinue = True
Do While bContinue '*** The Fun Starts Here ***
Do
set oFolder = oXpShell.BrowseForFolder(0, "Choose a Folder", 0)
If oFolder Is Nothing Then WScript.Quit
bAllowed = NotForbidden(oFolder.Self)
If Not bAllowed Then Msgbox sForbiddenMsg
Loop Until bAllowed
If Not bFreshStart And bPerFolderPrompt Then
If MsgBox(sPreservePrompt, vbYesNo + vbDefaultButton2, sScriptTitle) = vbYes Then
bPreserveViews = True
ElseIf MsgBox(sBlockPrompt, vbYesNo + vbDefaultButton2, sScriptTitle) = vbYes Then
BlockSubFolders oFolder
End If
End If
OpenAndCloseFolder oFolder, bOpenIsDefault, vbTrue
Set oFolderInfo = AddToSavedLists(oFolder)
If BlockedByMRUKey.Count > 0 Then BuildBlockedByMRUKey
If Not bPreserveViews Then
DeleteBagsBeneath oFolderInfo.MRUKey
End If
sFolderTemplateFile = MakeFolderTemplate(oFolderInfo.BagNumber, oFolder.Title)
RegImport sFolderTemplateFile
sMsg = "You have set view templates for the following folder(s):" & vbCrLf
For each sPath in SavedByNSPath
sMsg = sMsg & vbTab & sPath & vbCrLf
Next
sMsg = sMsg & vbCrLf & "Would you like to do another folder?"
bcontinue = (MsgBox (sMsg, vbYesNo) = vbYes)
Loop
LogInfo("Done: " & Now())
tsLog.close
Set oXpShell = Nothing
Set oWshShell = Nothing
Set oFso = Nothing
Msgbox sThanksMsg,,sThanksTitle
'---------------------------------------End-----------------------------------
Function MakeFolderTemplate (sBagNum, sFolderName) 'Returns path to template file
Const ForReading = 1
Dim sTemplateRegKey, sTemplateFileName, sFolderTemplate, ts
sTemplateRegKey = conBagsKey & "\" & sBagNum & "\Shell"
sFolderName = Replace(sFolderName, ":", "") 'No colons allowed in filenames
sTemplateFileName = "Folder Template" & "-" & sFolderName & "-Bag" & sBagNum & ".reg"
sFolderTemplate = RegExport (sTemplateRegKey, sWorkingPath, sTemplateFileName)
Set ts = oFso.OpenTextFile(sFolderTemplate, ForReading,, True)
sTemplateInfo = ts.ReadAll
ts.close
sTemplateInfo = Replace (sTemplateInfo, "\Shell]", "\Shell\Inherit]", 1, 2)
sTemplateInfo = Replace (sTemplateInfo, "My", "", 1, 1)
sTemplateInfo = Replace (sTemplateInfo, "Common", "", 1, 1)
Set ts = oFso.CreateTextFile (sFolderTemplate, True, True)
ts.Write sTemplateInfo
ts.Close
Set ts = Nothing
MakeFolderTemplate = sFolderTemplate
LogInfo("Template for " & sFolderName & " created: " & sTemplateFileName)
End Function
'----------------------------------------
Sub OpenAndCloseFolder (oFolder, bOpenIsDefault, bInteractive)
If bInteractive Then
If bOpenIsDefault Then
oXpShell.Open oFolder
Else
oXpShell.Explore oFolder
End If
WScript.Sleep 2000
MsgBox sSetViewPrompt,, sScriptTitle & " - Script Paused..."
CloseExplorerWindows
Else
If bOpenIsDefault Then
oXpShell.Open oFolder
Else
oXpShell.Explore oFolder
End If
Do Until GetExplorerWindowCount = 1
WScript.Sleep 1250
Loop
CloseExplorerWindows
Do Until GetExplorerWindowCount = 0
WScript.Sleep 1250
Loop
End If
End Sub
'-----------------------------------------
Sub BlockSubFolders (oParentFolder)
Dim oSubFolder
Dim sNSPath
Set oSubFolder = _
oXpShell.BrowseForFolder(0, "Select the folder you wish to block", 0, oParentFolder)
If oSubFolder is Nothing Then Exit Sub
sNSPath = NSPath(oSubFolder)
BlockedByNSPath(sNSPath) = sNSPath
BlockedByMRUKey(oSubFolder) = sNSPath '** MRUKey derived later because of flashing windows
If MsgBox("Block another?", vbYesNo, sScriptTitle) = vbYes Then
BlockSubfolders oParentFolder
End If
End Sub
'-----------------------------------------
Sub BuildBlockedByMRUKey()
Dim sNSPath, sBagNumber, sMRUNode
Keys = BlockedByMRUKey.Keys
For Each Key in Keys
If TypeName(Key) = "Folder3" Then
sBagNumber = GetBagNumber(Key)
sMRUNode = FindMRUSubKey(sBagNumber, conBagMRUKey)
BlockedByMRUKey(sMRUNode) = BlockedByMRUKey(Key)
BlockedByMRUKey.Remove(Key)
End If
Next
End Sub
'-----------------------------------------
Function NSPath (oFolder) 'Returns namespace path for oFolder
Dim dummy
On Error Resume Next
dummy = oFolder.ParentFolder.Title
If Err.Number = 0 Then
If oFolder.Self.Type = "Local Disk" Then
NSPath = oFolder.Self.Path
Else
NSPath = oFso.BuildPath(NSPath(oFolder.ParentFolder), oFolder.Title)
End If
Else
NSPath = oFolder.title
End If
On Error Goto 0
End Function
'-----------------------------
Function CheckSavePolicy ()
'*** Returns False if "NoSaveSettings" = 1, True otherwise ***
Const conSavePolicyKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSaveSettings"
Dim iTempData, bNoSave
bNoSave = False
On Error Resume Next
iTempData = oWshShell.RegRead(conSavePolicyKey)
If Err.Number = 0 Then '**value exists in registry
If (iTempData = 1) Then '** Policy is in effect
bNoSave = True
oWshShell.RegDelete(conSavePolicyKey)
LogInfo("NoSaveSettings in effect. Policy deleted & run aborted for restart")
End If
End If
On Error Goto 0
CheckSavePolicy = bNoSave
End Function
'-----------------------------
Function IsOpenDefault () 'Checks for default folder action: 'Open' vs 'Explore'
Dim sVerb
IsOpenDefault = True
On Error Resume Next
sVerb = oWshShell.RegRead("HKCR\Folder\shell\")
If Err.Number = 0 Then
If sVerb = "explore" Then IsOpenDefault = False
End If
On Error Goto 0
End Function
'-----------------------------
Sub InitForbiddenList () 'Avoid all drives but fixed and network places
Const ssfNETWORK = &H12
Dim colDrives, oDrive, oFolder, sNSPath
Set colDrives = oFso.Drives
For Each oDrive in colDrives
If oDrive.DriveType <> 2 Then
Set oFolder = oXpShell.NameSpace(oDrive.Path & "\")
sNSPath = NSPath(oFolder)
ForbiddenByNSPath.Add sNSPath, sNSPath
End If
Next
set oFolder = oXpShell.NameSpace(ssfNETWORK)
sNSPath = NSPath(oFolder)
ForbiddenByNSPath.Add sNSPath, sNSPath
End Sub
'-----------------------------------------
Function NotZipped(oFolderItem)
NotZipped = Not(CBool(InStr(oFolderItem.type, "zipped")))
End Function
'-----------------------------------------
Function NotSaved (oFolderItemOrString)
If TypeName(oFolderItemOrString) = "FolderItem2" Then
NotSaved = Not SavedByNSPath.Exists(NSPath(oFolderItemOrString.GetFolder))
Else
NotSaved = Not SavedByMRUKey.Exists(oFolderItemOrString)
End If
End Function
'-----------------------------------------
Function NotBlocked (oFolderItemOrString)
If TypeName(oFolderItemOrString) = "FolderItem2" Then
NotBlocked = Not BlockedByNSPath.Exists(NSPath(oFolderItemOrString.GetFolder))
Else
NotBlocked = Not BlockedByMRUKey.Exists(oFolderItemOrString)
End If
End Function
'-----------------------------
Function NotForbidden (oFolderItem)
NotForbidden = Not ForbiddenByNSPath.Exists(NSPath(oFolderItem.GetFolder))
If oFolderItem.Type = "Channel Shortcut" Then NotForbidden = False
End Function
'-----------------------------------------
Sub RegImport (sFileName)
Dim sCmd
sCmd = "reg import """ & sFileName & """"
oWshShell.Run sCmd, 0, True
End Sub
'-----------------------------------------
Function RegExport (sRegKey, sFilePath, sFileName)
'---Returns a string with full path to exported .reg file
Dim sCmd, sTemp, dummy
sTemp = oFso.BuildPath(sFilePath, sFileName)
sCmd = "reg export " & sRegKey & " """ & sTemp & """"
oWshShell.Run sCmd, 0, True
If oFso.FileExists(sTemp) then
RegExport = sTemp
Else
RegExport = ""
End If
End Function
'-----------------------------------------
Sub RegWriteBinary (sRegKey, sValueName, aValueData)
Dim sCmd, sTemp
sTemp = ""
For i = 0 to UBound(aValueData)
sTemp = sTemp & Right("0" & Hex(aValueData(i)), 2)
Next
sCmd = "reg add " & sRegKey & " /v " & sValueName & " /t reg_binary /d " & sTemp
oWshShell.Run sCmd, 0, True
End Sub
'-----------------------------------------
Sub RegDelete (sRegKey)
Dim sCmd, sTemp
sCmd = "reg delete " & sRegKey & " /f"
oWshShell.Run sCmd, 0, True
End Sub
'-----------------------------------------
Sub CmdCopy (sSource,sDestination)
sCmd = "%comspec% /c copy /y " & sSource & " " & sDestination
oWshShell.Run sCmd, 0, True
End Sub
'-----------------------------------------
Function GetBagNumber (oFolder)
const HKCU = &H80000001
dim sBagsFile, sAllFolders, sKey, arrSubKeys
sBagsFile = RegExport (conBagsKey,sWorkingPath,"Bags.sav")
RegDelete conBagsKey
sAllFolders = RegExport (conAllFolders,sWorkingPath,"AllFolders.sav")
'* Set explorer window to 5x5 pixels and place in corner to avoid flashing window
SetTinyOpen
'* clear explorer memory of last folder opened by opening 'my computer'
OpenAndCloseFolder oXpSHell.Namespace(17), bOpenIsDefault, False
'* clear bag created by 'my computer'
RegDelete conBagsKey
'* but that kills TinyOpen so:
SetTinyOpen
OpenAndCloseFolder oFolder, bOpenIsDefault, False
ClearTinyOpen
arrSubKeys = GetSubKeysOf(conBagsKey)
If Ubound(arrSubKeys) = -1 Then
MsgBox "Failed to get bag number"
wscript.quit
end if
GetBagNumber = arrSubKeys(0)
If sBagsFile <> "" Then
LogInfo("GetBag#: RegImport Started - " & Now())
RegImport sBagsFile
LogInfo("GetBag#: RegImport Done - " & Now())
oFso.DeleteFile(sBagsFile)
End If
If sAllFolders <> "" Then
RegImport sAllFolders
oFso.DeleteFile(sAllFolders)
End If
End Function
'-----------------------------------------
Function GetSubkeysOf (sKeyPath)
const HKCU = &H80000001
dim sPath, arrSubKeys
sPath = Right(sKeyPath, Len(sKeyPath) -5)
oRegistry.EnumKey HKCU, sPath, arrSubKeys
If IsNull(arrSubkeys) Then
GetSubkeysOf = Array()
Else
GetSubkeysOf = arrSubKeys
End If
End Function
'-----------------------------------------
Function FindMRUSubKey (sBagNumber, sMRUKey) 'As String
'** Determines which subkey of BagMRU has sBagNumber as it's NodeSlot value.
'** Assumes the folder for sBagNumber was the last folder opened and therefore
'** the first Dword of MRUListEx will be the only subkey requiring checking.
On Error Resume Next
iNodeSlot = oWshShell.RegRead(oFso.BuildPath(sMRUKey, "NodeSlot"))
If Err.Number = 0 Then
On Error Goto 0
If sBagNumber = CStr(iNodeSlot) Then
FindMRUSubKey = sMRUKey
Exit Function
End If
End If
On Error Goto 0
arrSubKeys = oWshShell.RegRead(oFso.BuildPath(sMRUKey, "MRUListEx"))
sSubKey = 0
For i = 0 to 3
sSubKey = (arrSubKeys(i) * (256^i)) + sSubKey
Next
sSubKey = CStr(sSubKey)
FindMRUSubKey = FindMRUSubKey(sBagNumber, oFso.BuildPath(sMRUKey, sSubKey))
End Function
'-----------------------------------------
Function GetBagCollection (sMRUKey)
Dim arrSubKeys
Dim sBagNums, sSubKey, sTempCol
Dim iBagNum
arrSubKeys = GetSubkeysOf(sMRUKey)
sBagNums = ""
For each sKey in arrSubKeys
sSubKey = oFso.BuildPath(sMRUKey, sKey)
If NotBlocked(sSubKey) and NotSaved(sSubKey) Then
sTempCol = Join(GetBagCollection(sSubKey), ",")
If Len(sTempCol) > 0 Then
If Len(sBagNums) = 0 Then
sBagNums = sTempCol
Else
sBagNums = sBagNums & "," & sTempCol
End If
End If
On Error Resume Next
iBagNum = oWshShell.RegRead(oFso.BuildPath(sSubKey, "NodeSlot"))
If Err.Number = 0 Then
If Len(sBagNums) = 0 Then
sBagNums = CStr(iBagNum)
Else
sBagNums = CStr(iBagNum) & "," & sBagNums
End If
End If
On Error Goto 0
End If
Next
GetBagCollection = Split(sBagNums, ",")
End Function
'----------------------------------------------
Sub DeleteBagsBeneath (sMRUKey)
Dim arrBagsToDelete
arrBagsToDelete = GetBagCollection(sMRUKey)
For each sBagNumber in arrBagsToDelete
RegDelete oFso.BuildPath(conBagsKey, sBagNumber)
Next
End Sub
'----------------------------------------------
Function GetNodeSlotCount()
GetNodeSlotCount = Ubound(oWshShell.RegRead(oFso.BuildPath(conBagMRUKey, "NodeSlots"))) + 1
End Function
'----------------------------------------------
Function GetBagCount()
Dim arrBags
arrBags = GetSubkeysOf(conBagsKey)
GetBagCount = Ubound(arrBags) + 1
End Function
'----------------------------------------------
Function GetViewLimit()
On Error Resume Next
GetViewLimit = oWshShell.RegRead(conViewLimitValue)
If err.number <> 0 Then
GetViewLimit = 400
End If
On Error Goto 0
End Function
'----------------------------------------------
Function AddToSavedLists (oFolder)
sBagNumber = GetBagNumber(oFolder)
sMRUSubKey = FindMRUSubKey(sBagNumber, conBagMRUKey)
sNSPath = NSPath(oFolder)
SavedByNSPath.Add sNSPath, sNSPath
SavedByMRUKey.Add sMRUSubKey, sNSPath
Set AddToSavedLists = New FolderInfo
AddToSavedLists.BagNumber = sBagNumber
AddToSavedLists.MRUKey = sMRUSubKey
End Function
'----------------------------------------------
Sub LogInfo (sInfo)
tsLog.writeline sInfo
End Sub
'----------------------------------------------
Sub InitLog ()
set tsLog = oFso.CreateTextFile (oFso.BuildPath(sWorkingPath, "Log.txt"))
LogInfo("Working Path = " & sWorkingPath)
End Sub
'----------------------------------------------
Sub CreateUndoFile()
sUndoPath = RegExport("HKCU\Software\Microsoft\Windows\ShellNoRoam", sWorkingPath, conUndoFile)
LogInfo("Undo File created: " & sUndoPath)
End Sub
'----------------------------------------------
Function OfferFreshStart()
Dim iResult
OfferFreshStart = False
iResult = Msgbox(sFreshStart, vbYesNo + vbDefaultButton2, "Fresh Start?")
If iResult = vbYes Then
RegDelete conBagMRUKey
RegDelete conBagsKey
OfferFreshStart = True
End If
End Function
'----------------------------------------------
Sub SetTinyOpen()
Dim sPrefix
'Names of reg values are dependent on screen resolution, so:
With CreateObject("htmlfile")
With .ParentWindow.Screen
sPrefix = "WinPos" & .width & "x" & .height & "(1)."
end with
end with
oWshShell.RegWrite conAllFolders & "\Shell\WFlags", 0, "REG_DWORD"
oWshShell.RegWrite conAllFolders & "\Shell\" & sPrefix & "bottom", 5, "REG_DWORD"
oWshShell.RegWrite conAllFolders & "\Shell\" & sPrefix & "left", 0, "REG_DWORD"
oWshShell.RegWrite conAllFolders & "\Shell\" & sPrefix & "right", 5, "REG_DWORD"
oWshShell.RegWrite conAllFolders & "\Shell\" & sPrefix & "top", 0, "REG_DWORD"
End Sub
Sub ClearTinyOpen()
RegDelete conAllFolders
End Sub
'----------------------------------------------
Sub OfferMaxLimit()
If MsgBox(sMaxLimitMsg, vbYesNo + vbDefaultButton2, "Increase Limit for Saved Views?") = vbYes Then
oWshShell.RegWrite conViewLimitValue, conMaxBags, "REG_DWORD"
End If
End Sub
'----------------------------------------------
Function OfferPerFolderOption()
OfferPerFolderOption = False
If MsgBox(sPerFolder, vbYesNo + vbDefaultButton2, "Preserve Existing Views?") = vbYes Then
OfferPerFolderOption = True
End If
End Function
'----------------------------------------------
Sub InitStrings ()
Dim dNow, sRunID, sScriptPath
sScriptTitle = "Folder ViewMaster III"
dNow = Now()
sRunID = Year(dNow) & Right(100 + Month(dNow), 2) _
& Right(100 + Day(dNow), 2) & "-" & Right(100 + Hour(dNow), 2) _
& Right(100 + Minute(dNow), 2) & Right(100 + Second(dNow), 2)
sScriptPath = oFso.GetParentFolderName( wscript.scriptfullname)
sScriptPath = oFso.GetFolder(sScriptPath).ShortPath
sWorkingPath = oFso.BuildPath(sScriptPath, SRunID)
sIntroMsg = "This script will allow you to customize the view for a folder and " _
& "then have that view applied as a template for all of the folder's subfolders. " _
& "Your old settings " _
& "will be backed-up and available for restoration should you be unhappy " _
& "with the results." & vbCrLf & vbCrLf _
& "In general, you can process folders in any order -- " _
& "However, if you plan on setting a template for 'My Documents', you should " _
& "first set templates for 'My Music' and 'My Pictures'. If you don't, " _
& "these folders will inherit the 'Document' folder template and you will " _
& "lose the Common Tasks specific to those folders." & vbCrLf & vbCrLf _
& "Also, different views are saved for 'My Documents' and its " _
& "subfolders, depending on how they are accessed:" & vbCrLf & vbCrLf _
& vbTab & "'Desktop\My Documents'" & vbCrLf & vbTab & "'My Computer\My Documents'" _
& vbCrLf & vbTab & "'C:\Docs and Settings\<username>\My Documents'" & vbCrLf _
& vbCrLf & "are seperate and unique as far as views are concerned. You may want " _
& "to take a minute to verify which way you normally access these folders by opening one " _
& "and viewing the folder pane to determine the path." & vbCrLf & vbCrLf _
& "Do you wish to continue?"
sIntro2 = "This script will be opening and closing explorer windows in order to " _
& "apply the views. It is recommended you close other applications to run " _
& "this Script. To function properly, It is IMPERATIVE that you not have " _
& "any Explorer windows open. If you have any open, please close " _
& "them before clicking 'OK'" & vbCrLf & vbCrLf & "Do you wish to continue?"
sNotReady = " Explorer windows are still open! Please close them now."
sMaxLimitMsg = "You're current settings limit the number of saved views to " & GetViewLimit() _
& ". Would you like to increase this to the maximum value of " & conMaxBags & "?"
sFreshStart = "You currently have " & GetNodeSlotCount() & " index entries for saved views and " _
& GetBagCount() & " actual saved views (These numbers may differ as certain actions will " _
& "delete the views but not the index). You will have a choice to delete or preserve " _
& "the views under each folder you process or your can delete all saved views " _
& "at this time." & vbCrLf & vbCrLf & "Would you like delete ALL saved views?"
sPerFolder = "The most consistent results are achieved by allowing FVM to delete the old saved views " _
& "for the folders you process, ensuring the new template is applied to all subfolders. " _
& "For more selective work, you can opt to be prompted to save some or all of the " _
& "current views under each folder. Would you like to be prompted on a per folder basis?"
sForbiddenMsg = "You've selected a folder we cannot process. Please select another."
sSetViewPrompt = "Alt+Tab to the Folder window now open and set all view options to your " _
& "liking." & vbCrLf & vbCrLf & vbTab & "DO NOT CLOSE THE FOLDER YOURSELF!" _
& vbCrLf & vbCrLf & "When you are done, Alt+Tab back to this window & click 'OK'."
sPreservePrompt = "Would you like to preserve ALL subfolder views that are currently saved?"
sBlockPrompt = "Would you like to preserve views for specific subfolders?"
sRestartMsg = "There was a policy on your computer to prohibit saving folder views. " _
& "This has been changed, but you will need to log off and log back on for this " _
& "change to take effect."
sThanksTitle = "Thank you for using FolderViewMasterIII"
sThanksMsg = "Questions? Comments? Suggestions?" & vbCrLf & vbCrLf & VbTab _
& "E-mail me at: [email protected]"
End Sub
'-----------------------------------------
Function GetExplorerWindowCount()
Dim sExpPath, iWinCount, oWindow
sExpPath = LCase(oWshShell.ExpandEnvironmentStrings("%WinDir%") & "\Explorer.EXE")
iWinCount = 0
For each oWindow in oXpShell.Windows
If (LCase(oWindow.fullName) = sExpPath) Then iWinCount = iWinCount + 1
Next
GetExplorerWindowCount = iWinCount
End Function
Sub CloseExplorerWindows()
Dim sExpPath, oWindow
sExpPath = LCase(oWshShell.ExpandEnvironmentStrings("%WinDir%") & "\Explorer.EXE")
For each oWindow in oXpShell.Windows
If (LCase(oWindow.fullName) = sExpPath) Then oWindow.Quit
Next
End Sub
