(drop me a PM with your email addy if you want me to send this to you directly...I noticed the forum dropped the PIPE symbol and I don't know what else...)
Here's the script that we cobbled together to search and cleanup user shortcuts and a few other things after a third party software distribution.
This is probably more complicated than it needs to be. Our initial thought was to scan the entire c:\documents and settings directory to find/replace shortcuts. That approach became troublesome because it ran into file locks and it was very resource intensive.
This *attempt* was written to check the registry for the profile paths, disregard the systemprofile, network service and help assistance profiles that the registry returns...affix specific search paths to those profiles, find the particular shortcuts and acquire new ones from a file share.
It logs to c:\scriptLog.log
There is also some crap at the end of the script that checks the registry and updates some settings for the new program version.
If I remember correctly, a big problem we had with this script is that it seemed to skip over profiles and directories and not even scan them! We never managed to get this thing to where we wanted it so we ended up manually updating user shortcuts.
Some of the variable names are going to be screwy because it's a combination of scripts that were pulled off the internet, work I did and work the other admin did. There may be a fair amount of crap in the script that does absolutely nothing...reviewing it I noticed there are two seperate "Create Object FileScripting" references
EDIT--->I just noticed that the "arrFileSearch(0) and (1) the forum didn't take the lines correctly.
It won't take the PIPE character. should read:
arrFileSearch(0) = "Shortcut(PIPE)\\myfileserver\install$\sungard\newshortcut\Someshortcut.Ink"
On Error Resume Next
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForWriting = 2
Dim arrFileSearch(1)
'shortcuts (renamed
arrFileSearch(0) = "Shortcut\\myFileServer\install$\Sungard\NewShortuts\Some_Shortcut.lnk"
arrFileSearch(1) = "Other_Shortcut\\myFileServer\install$\Sungard\NewShortuts\Some_Other_Shortcut.lnk"
'for logging the script actions
Set testFSO = CreateObject("Scripting.FileSystemObject")
Set testFile = testFSO.CreateTextFile("C:\scriptLog.txt", True)
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strComputer
strComputer = "."
Dim strValueName
Dim strValue
Dim arrDirectories()
intSize = 0
'Array to hold the profile paths
'pre-populate with "c:\documents and settings\all users"
Dim arrProfilePaths()
Dim intCount
intCount = 0
ReDim Preserve arrProfilePaths(intCount)
arrProfilePaths(intCount) = "C:\Documents and Settings\All Users"
intCount = intCount + 1
Dim strStartingPoint
Dim arrSearchPaths(3)
'specific paths we wish to search to add onto the profile paths
arrSearchPaths(0) = "\Desktop"
arrSearchPaths(1) = "\Application Data\Microsoft\Internet Explorer\Quick Launch"
arrSearchPaths(2) = "\Application Data\Microsoft\Office\Shortcut Bar"
arrSearchPaths(3) = "\Start Menu"
Dim strResults
'check the registry
Set objRegistry=GetObject("winmgmts:\\" & _
strComputer & "\root\default:StdRegProv")
Set FSO = CreateObject("Scripting.FileSystemObject")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each objSubkey In arrSubkeys
strValueName = "ProfileImagePath"
strSubPath = strKeyPath & "\" & objSubkey
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
'disregard the system profile, local service, network service and help assistant profiles
If strValue = "C:\WINDOWS\system32\config\systemprofile" Or strValue = "C:\Documents and Settings\LocalService" Or strValue = "C:\Documents and Settings\NetworkService" Or strValue = "C:\Documents and Settings\HelpAssistant" Then
'Write to profile paths array
Else
ReDim Preserve arrProfilePaths(intCount)
arrProfilePaths(intCount) = strValue
intCount = intCount + 1
End If
Next
For Each strProfilePaths in arrProfilePaths
For Each strSearchPaths in arrSearchPaths
strStartingPoint = strProfilePaths & strSearchPaths
If FSO.FolderExists(strStartingPoint) Then
ShowSubfolders FSO.GetFolder(strStartingPoint)
End If
Next
Next
'Recursive Look for all sub folders starting at the starting point that are not hidden folders
Sub ShowSubFolders(Folder)
'Checks to see if the folder is hidden
' If Folder.Name = "TEMP" Or Folder.Name = "Temp" Or Folder.Name = "Temporary Internet Files" Or Folder.Name = "NetHood" Or Folder.Name = "Identities" Or Folder.Name = "Credentials" Or Folder.Name = "CryptnetUrlCache" Or Folder.Name = "HelpAssistant" Or Folder.Name = "LocalService" Or Folder.Name = "NetworkService" Or Folder.Name = "cache" Or Folder.Name = "Installer" Or Folder.Name = "History" Then
' Else
For Each Subfolder in Folder.SubFolders
'Changes the array size
ReDim Preserve arrDirectories(intSize)
arrDirectories(intSize) = Subfolder.Path
intSize = intSize + 1
ShowSubFolders Subfolder
Next
' End If
End Sub
''Gets all of the files in the Directories previously found
For Each Directory in arrDirectories
testFile.Writeline(Directory & vbCRLF)
For Each objFile in FSO.getfolder(Directory).Files
'Checks to make sure there is a file
If IsObject(objFile) Then
'Goes through the array of items to search for
For Each strFile in arrFileSearch
Dim arrFileSearchSplit
strFileSearchSplit = Split(strFile, "|")
'Checks to make sure that the length of the file found and
'the lenght of the file to search for are at least the same
If Len(objFile.Name) >= Len(strFileSearchSplit(0)) then
'Checks the to see if the string to search contains the string to search for
If InStr(1, objFile.Name, strFileSearchSplit(0)) > 0 And objFile.Type = "Shortcut" Then
strResults = strResults & "Found One " & ObjFile.Path & ":" & objFile.Name & vbCRLF
FSO.DeleteFile ObjFile.Path, True
FSO.CopyFile strFileSearchSplit(1), Directory & "\", True
End If
End If
Next
End If
Next
Next
'''Deletes the Old AppFolder if it exists
If FSO.FolderExists("C:\SomeFolder") Then
FSO.DeleteFolder("C:\SomeFolder")
End If
''Deletes the BiTech Folder if it exists
If FSO.FolderExists("C:\AnotherFolder") Then
FSO.DeleteFolder("C:\AnotherFolder")
End If
If FSO.FolderExists("C:\YetAnother") Then
FSO.DeleteFolder("C:\YetAnother")
End If
testFile.Close
'THE FOLLOWING SECTION CHECKS REGISTRY AND UPDATES OPTIONS FOR NEW 'PROGRAM VERSION
On Error Resume Next
Const HKCU = &H80000001
Const HKLM = &H80000002
strComputer = "."
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
' check HCLM
strkeyPath = "SOFTWARE\SomeVendor\SomeProgram"
valueName = "someValue"
objReg.GetDWORDValue HKLM, strKeyPath, ValueName, dwValue
If IsNull(dwValue) or dwValue = 1 Then
objReg.SetDWORDValue HKLM, strkeyPath, ValueName, 0
End If
' Check HCKU
strKeyPath = "Software\SomeVendor\SomeProgramOptions\General"
ObjReg.GetDWORDValue HKCU, strKeyPath, ValueName, dwValue
If IsNull(dwValue) or dwValue = 1 Then
ObjReg.SetDWORDValue HKCU, strKeyPath, ValueName, 0
End If
FSO = Nothing
Err.Clear()