Code to determine whether a folder is a Trusted Location

The following code from ...

http://www.experts-exchange.com/Programming/Languages/Scripting/Q_24197322.html?sfQueryTermInfo=1+locat+trust

makes a folder a Trusted Location.

Can this code be modified to first determine whether or not a folder is already a Trusted Location and, if not, then execute the code to make it a Trusted Location?

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
 
strProgram = "Excel"
strFolder = "c:\files"
strDescription = "my custom folder"
blnAllowSubFolders = True
blnAllowNetworkLocations = True
 
strParentKey = "Software\Microsoft\Office\12.0\" & strProgram & "\Security\Trusted Locations"
intHighest = 0
 
Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
 
objRegistry.EnumKey HKEY_CURRENT_USER, strParentKey, arrChildKeys
 
For Each strChildKey in arrChildKeys
    If CInt(Mid(strChildKey, 9)) > intHighest Then
        intHighest = CInt(Mid(strChildKey, 9))
    End If
Next
 
strNewKey = strParentKey & "\Location" & CStr(intHighest + 1)
 
objRegistry.CreateKey HKEY_CURRENT_USER, strNewKey
objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Path", strFolder
objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Description", strDescription
 
If blnAllowSubFolders Then
    objRegistry.SetDWORDValue HKEY_CURRENT_USER, strNewKey, "AllowSubFolders", 1
End If
 
If blnAllowNetworkLocations Then
    objRegistry.SetDWORDValue HKEY_CURRENT_USER, strParentKey, "AllowNetworkLocations", 1
End If
twarrenbAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robberbaron (robr)Commented:
yes.... http://blogs.technet.com/heyscriptingguy/archive/2005/06/03/hey-scripting-guy-how-can-i-list-all-the-user-profiles-on-a-computer.aspx

I had to add a test for LocationX as my XP box also has an OCTLocation0 key.

'original script by Shift-3 '
'http://www.experts-exchange.com/Programming/Languages/Scripting/Q_24197322.html'

'modified by Robberbaron Apr 2010'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
 
strProgram = "Excel"
strFolder = "c:\ee\done"
strDescription = "my custom folder"
blnAllowSubFolders = True
blnAllowNetworkLocations = True

strParentKey = "Software\Microsoft\Office\12.0\" & strProgram & "\Security\Trusted Locations"
intHighest = 0
bCurrectTrusted = false

Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
 
objRegistry.EnumKey HKEY_CURRENT_USER, strParentKey, arrChildKeys
'get the highest key number'
For Each strChildKey in arrChildKeys
    If Left(strChildKey,8)="Location" then
	    If CInt(Mid(strChildKey, 9)) > intHighest Then
	        intHighest = CInt(Mid(strChildKey, 9))
	    End If
	
		'check to see if the folder is already trusted' 
	    strValueName = "Path"
	    strSubPath = strParentKey & "\" & strChildKey
	    objRegistry.GetExpandedStringValue HKEY_CURRENT_USER,strSubPath,strValueName,strValue
	    Wscript.Echo strSubPath & "=" & strValue
	    If strValue = strFolder Then
	    	bCurrentTrusted = True
	    End if
	End if
Next
 

If bCurrentTrusted Then
	WScript.Echo ">" & strFolder & " is already trusted"
 else
 
	 
	'add new'
	strNewKey = strParentKey & "\Location" & CStr(intHighest + 1)
	 
	objRegistry.CreateKey HKEY_CURRENT_USER, strNewKey
	objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Path", strFolder
	objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Description", strDescription
	 
	If blnAllowSubFolders Then
	    objRegistry.SetDWORDValue HKEY_CURRENT_USER, strNewKey, "AllowSubFolders", 1
	End If
	
	If blnAllowNetworkLocations Then
	    objRegistry.SetDWORDValue HKEY_CURRENT_USER, strParentKey, "AllowNetworkLocations", 1
	End If
	
	WScript.Echo ">" & strFolder & " added as trusted"

End if

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Robberbaron (robr)Commented:
OCTLocation =Office Customization Tool (OCT)

http://technet.microsoft.com/en-us/library/cc178992.aspx
0
twarrenbAuthor Commented:
This code works fine except for the messages.  At each of the following, run-time error '424' ("Object required) appears.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

twarrenbAuthor Commented:
Sorry.  Meant to say:

This code works fine except for the script messages.  At each of the following, run-time error '424' ("Object required) appears.

WScript.Echo ">" & FolderPath & " is already trusted"
WScript.Echo ">" & FolderPath & " added as trusted"
WScript.Echo strSubPath & "=" & strValue
0
Robberbaron (robr)Commented:
1. you are running this as a VBS ?
2. the variable names arent the same as mine which is ok but have you placed an option explicit at the top that would be throwing the exception for FolderPath ?

need to post more of your code to debug as my code worked fine on an XP SP3 box.
0
twarrenbAuthor Commented:
I'm running your code as Access (2010) VB on Windows 7.   Option Explicit is at the top of the module.

I ran your original code with only one modification, namely, strParentKey = ...\Office\14.0\... rather than
...\Office\12.0\...  I got the same error message.

However, the error (if it is such) is of no consequence.  The code works fine with the three WScript.Echo
lines removed.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.