OU Based Favorites

oufavorites.vbs

' Assign Favorites Based on OU
' Written by Adam "Arcath" Laycock
' December 2011

' Variables

Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objShell=CreateObject("Wscript.Shell" ) 'Create the Shell Object

favUnc = "\\hpml350\School Folders\Pupil Favorites\" ' Set This to the UNC path for your favorits folder


KeyName = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\" ' Registry Key for Favorites

' Functions

' Get First Match
' Returns the First REGEX Match for the pattern you supply
' from http://www.somacon.com/p138.php
Function GetFirstMatch(PatternToMatch, StringToSearch)
	Dim regEx, CurrentMatch, CurrentMatches

	Set regEx = New RegExp
	regEx.Pattern = PatternToMatch
	regEx.IgnoreCase = True
	regEx.Global = True
	regEx.MultiLine = True
	Set CurrentMatches = regEx.Execute(StringToSearch)

	GetFirstMatch = ""
	If CurrentMatches.Count >= 1 Then
		Set CurrentMatch = CurrentMatches(0)
		If CurrentMatch.SubMatches.Count >= 1 Then
			GetFirstMatch = CurrentMatch.SubMatches(0)
		End If
	End If
	Set regEx = Nothing
End Function


'Connect to AD
Set objSysInfo = CreateObject("ADSystemInfo")


' Get LDAP entry to current computer object.
strUserDN = objSysInfo.UserName
' Set objUser = GetObject("LDAP://" & strUserDN)

strOU = GetFirstMatch("OU=(.*?),OU=", strUserDN)
 
objShell.RegWrite KeyName & "Favorites", favUNC + strOU + "\Favorites"