'~~Author~~. Rob Dunn
'
'~~Blatently borrowed a little bit of code from~~. Jim de Graff
'
'~~Script_Type~~. vbscript
'
'~~Sub_Type~~. SystemAdministration
'
'~~Keywords~~. change shortcuts, string, migration,
' mapped drive, new server, LNK, target path
'
'~~Comment~~.
'This script searches the given folder (and sub-folders) for shortcuts
' that contains a particular string (i.e. "c:\temp\shortcut_target.exe"
' first it will prompt you to type the string you wish to replace,
' after which, it prompts for the new string. Finally, it will ask
' you for the root folder which you would like to begin the search
' (and replace). If you run in verbose mode, you will be prompted
' to say 'yes' for each shortcut you'd like to change. After it's
' finished, it will present you with an HTM of the changes that
' were made.
'
'This script only works with single instances of a string - if there are
' more than one instance, the script will change the first instance.
'
'A few lines below are variables that you can set to modify the behavior
' of the script. In this form, Silent = 0 (off), which will prompt you
' with each shortcut it finds that meet the criteria specified in the
' initial input boxes. As it finds matching shortcuts, it will prompt
' you to type 'yes' to change the shortcuts.
'
'I just changed a server name at a location, and all the users had a
' TON of shortcuts pointing to the old server name, so I put this
' together to save me time, and it worked great!
'
'At the very end, it will open up an HTM file with the results of the
' shortcuts that it finds (and highlight which ones are updated)
'
'Per Jim de Graff: "also demonstrates how to traverse a directory tree"
' using recursion."'
'~~Script~~.
Dim Silent, CurTime, sIsDrive
Dim newlink, oldlink, oldfull, fullname, oldfile, bgcolor
Dim CheckFolder, RootFolder
Dim w, ws
const ForReading = 1
const ForWriting = 2
const ForAppending = 8
'On Error Resume Next
'Find current time that the script runs
set wso = CreateObject("Wscript.Shell")
set fso = CreateObject("Scripting.FileSystemObject")
'pull the system's process variables (we'll be using TEMP
' for the output file and WINDIR to figure out the default
' location of user's desktop folder - whether 9x or NT/2k/XP)
Set WshSysEnv = wso.Environment("PROCESS")
'pull the system's profile environment variable
userprofile = wso.ExpandEnvironmentStrings("%userprofile%")
'set your variables here
'silent = 0/1/2
' 0 - verbose
' 1 - turns off verification prompts
' 2 - turns off verification and initial config prompts
'ChangePathFrom = string you wish to replace
'ChangePathTo = string you wish to change ChangePathFrom to
' above server vars are needed only for when silent = 2
'ouputfile = location of output filename, you can use a string in
' place of all the code after the equal sign (i.e.
' outputfile = "x:\temp," etc.)
'curtime = finds time of execution of script
'RootFolder = The folder that you wish to search (silent mode only)
'--------------------------------------------------------------------
' set your variables below...
'--------------------------------------------------------------------
Silent = 1
ChangePathFrom = "\\test1" 'string to search for
ChangePathTo = "\\test2" 'string to replace with
OutputFile = WshSysEnv("TEMP") & "\" & "migrate_shortcuts_log.htm"
RootFolder = "c:\shortcut"
'--------------------------------------------------------------------
CurTime = Now
OSType = WshSysEnv("OS")
WinDirectory = WshSysEnv("WINDIR")
If Silent > 0 Then
CheckFolder = RootFolder
Else
End If
If CheckFolder = "" Then
If OSType <> "Windows_NT" Then
'Windows 9x/Me desktop folder
CheckFolder = Windirectory & "\desktop"
Else
'Windows NT/2k/XP desktop folder
CheckFolder = userprofile & "\desktop"
End If
End If
'check to see if ouputfile exists or not, deletes it if it does
If CheckFileExists(OutputFile) Then
Set oldfile = fso.GetFile(OutputFile)
oldfile.Delete
Else
'wscript.echo oldfile & " does not yet exist."
End If
If Silent <= 1 Then
Call CServer
End If
'Bring up inputbox for old server string
Sub CServer
ChangePathFrom = InputBox ("Type the string of text that you wish to"_
& " replace in your shortcuts (LNK Files).","Enter text string to replace",ChangePathFrom)
ChangePathFrom = LCase(ChangePathFrom)
Check4FromSlash = Right(ChangePathFrom,1)
VarLengthCPF = Len(ChangePathFrom)
If Check4FromSlash = "\" Then
VarLengthCPF = VarLengthCPF - 1
ChangePathFrom = Left(ChangePathFrom, VarLengthCPF)
If Silent = 0 Then
wscript.echo "Now Removing trailing '\' from " & ChangePathFrom & "."
End If
End If
If ChangePathFrom = "" Then
wscript.quit
Else
Call NServer
End If
End Sub
'Bring up inputbox for new server string
Sub NServer
'wscript.echo changepathfrom
ChangePathTo = InputBox ("Enter the string of text you would like to " & ""_
& " replace instances of " & Chr(34) & ChangePathFrom & Chr(34) & ""_
& " with.","Enter new text string" & ".",ChangePathTo)
ChangePathTo = LCase(ChangePathTo)
Check4ToSlash = Right(ChangePathTo,1)
VarLengthCPT = Len(ChangePathTo)
If Check4ToSlash = "\" Then
VarLengthCPT = VarLengthCPT - 1
ChangePathTo = Left(ChangePathTo, VarLengthCPT)
If Silent = 0 Then
wscript.echo "Now Removing trailing '\' from " & ChangePathTo & "."
End If
End If
If ChangePathTo = "" Then
Call CServer
Else
Call CFolder
End If
End Sub
'Bring up inputbox for root folder to search (recursive)
Sub CFolder
CheckFolder = InputBox ("Type the root folder path that you wish to"_
& "start your scan from (recursive).","Begin shortcut (lnk) scan"_
& "from:",CheckFolder)
If CheckFolder = "" Then
Call NServer
End If
End Sub
'Start writing the HTM Log file...
Set w = fso.OpenTextFile (OutputFile, ForAppending, True)
w.Writeline ("")
w.Writeline ("Changing Shortcuts in root folder "_
& CheckFolder & "")
w.Writeline ("")
w.Writeline ("")
w.Writeline ("| ")
w.Writeline (" ")
w.Writeline (" | ")
w.Writeline ("
")
w.Writeline (""_
& "Shortcuts located in: "_
& CheckFolder & " ,"_
& " searching recursively at " & CurTime & "")
w.WriteLine ("")
w.WriteLine ("| Shortcut Path"_
& " | ")
w.WriteLine (" Target Path"_
& " | ")
w.WriteLine (" Updated to"_
& " | ")
w.WriteLine ("
")
If ChangePathFrom = "" Then
wscript.echo "You have not specified a source string to change."
Call Cserver
ElseIf ChangePathTo = "" Then
wscript.echo "You have not specified a new string name to"_
& " replace" & Chr(34) & ChangePathFrom & Chr(34) & " with."
Call Nserver
ElseIf CheckFolder = "" Then
wscript.echo "You must specify a root folder to begin your"_
& " search from."
Call CFolder
End If
'process the shortcuts
ModifyLinks CheckFolder
Sub ModifyLinks (foldername)
dim file 'for stepping through the files collection '
dim folder 'for stepping through the subfolders collection '
dim fullname 'fully qualified link file name '
dim link 'object connected to the link file '
'process all the files in the folder
For each file in fso.GetFolder(foldername).Files
'check only link files
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then
'Find full path of shortcut
fullname = fso.GetAbsolutePathName(file)
'Find full path of target within shortcut
set link = wso.CreateShortcut(fullname)
targetpath = LCase(link.targetpath)
oldfull = fullname
oldlink = targetpath
newlink = "Not Updated"
'Displays current shortcut that is being checked (good for
' troubleshooting the script).
'If Silent = 0 Then
'MsgBox "Checking shortcut: " & fullname & "." & VBCrlf_
'& "Shortcut target: " & targetpath
'End If
'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, ChangePathFrom) > 0 Then
sChangeTargetTo = ""
sChangePathTo = ""
'Set numerical length of full target path
VarLengthPath = Len(targetpath)
'Set numerical length of ChangePathFrom
VarLengthCPF = Len(ChangePathFrom)
'Find out what's between character 0 and where changepathfrom starts
VarBeginPath = InStr(1, targetpath, ChangePathFrom)
'Subtract 1 from where it begins (all text begins at 1 in a string)
'This is so you will have a '0' value if you type in a root drive or
'UNC to replace - there shouldn't be anything that appears before
''c:\' or '\\server' etc.
VarBeginPath = VarBeginPath - 1
'Parse actual text prior to search string to replace
BeginPath = Null
BeginPath = Left(targetpath, VarBeginPath)
'wscript.echo "VarBeginPath is: " & VarBeginPath & ". " & BeginPath
'Find out how many characters are left after subtracting the beginpath
'and search strings from the whole path
VarEndPath = VarLengthPath - (VarBeginPath + VarLengthCPF)
'Find out what text appears after the search string
EndPath = Right(targetpath, VarEndPath)
'wscript.echo EndPath
workingpath = link.workingdirectory
'Set variable to text before/search string/text after, so you get
'something like: c:\stuffbeforestring\mysearchstring\stuffafterstring
'or c:\temp\docs\mysearchstring\test.doc
sChangePathTo = BeginPath & ChangePathTo & EndPath
'wscript.echo "ChangePathTo is: " & ChangePathTo
'If there is no working directory, then text will show 'not set' during
'script execution
If workingpath = "" Then
workingpath = "not set"
End If
'if you are running in verbose mode, you will be prompted with
'each shortcut and working folder.
If Silent = 0 Then
MyVar = MsgBox ("Path contains " & Chr(34) & ChangePathFrom & "." & Chr(34) & ""_
& " LNK file's full target path is: "_
& targetpath & "." & " Working path is "_
& workingpath & ".",64, fullname)
End If
'Sometimes shortcuts don't have working dirs (not sure why)
'If there is a working dir, then run following code
If workingpath <> "not set" Then
VarBeginPath = InStr(1, workingpath, ChangePathFrom)
If VarBeginPath > 0 Then
VarBeginPath = VarBeginPath - 1
End If
'Parse actual text prior to search string to replace
BeginPath = Null
'wscript.echo "VarBeginPath " & VarBeginPath
BeginPath = Left(workingpath, VarBeginPath)
'wscript.echo "Working beginpath is: " & BeginPath
'Set numerical length of working directory
VarLengthWorking = Len(link.workingdirectory)
VarEndPath = VarLengthWorking - (VarBeginPath + VarLengthCPF)
'wscript.echo "Working path number count is: " & varlengthworking & ""_
'& VBCRLF & "working path end
'wscript.echo "VarEndPath = " & VarEndPath & " = " & VarLengthWorking & ""_
'& " - (" & VarBeginPath & " + " & VarLengthCPF & ")"
'Find out what text appears after the search string
If VarEndPath >= 0 Then
EndPath = Right(workingpath, VarEndPath)
sChangeTargetTo = BeginPath & ChangePathTo & EndPath
'wscript.echo "ChangeTargetTo is: " & sChangeTargetTo
WorkingMSG = "Also change working directory to " & sChangeTargetTo & "?"
End If
'wscript.echo "End of working folder :" & EndPath
Else
link.workingdirectory = ""
WorkingMSG = "No working directory will be set at this time."
End If
'wscript.echo "Path of shortcut is " & targetpath & ""_
'& VBCRLF & ". Working folder is " & workingpath & "."
'Display input box to modify each shortcut as the script finds them
If Silent = 0 Then
ModifyPath = InputBox ("Modifying " & fullname & "." & VBCRLF & ""_
& VBCRLF & "Modify path for " & targetpath & " "_
& "and replace with " & sChangePathTo & "?" & VBCRLF & VBCRLF & ""_
& WorkingMSG,""_
& "Type 'yes' to modify")
ElseIf Silent >= 1 Then
ModifyPath = "yes"
End If
If ModifyPath = "yes" Then
bgcolor = "#99CCFF"
'Set link target path attribute to
link.targetpath = Chr(34) & sChangePathTo & Chr(34)
newlink = link.targetpath
'wscript.echo newlink
If VarLengthWorking <> "" Then
'Set link working dir attribute to
' \\ChangePathToname\workingpath
link.workingdirectory = Chr(34) & sChangeTargetTo & Chr(34)
End If
'Save the shortcut with the new information
link.save
'If answer above is anything but yes, the script will proceed
' to the next shortcut
Else
End if
'Clear link variable
MyPos = 0
MyPosEnd = 0
End if
'write output to logfile
Call WriteEntry
End If
Next
'process all the subfolders in the folder
For each folder in fso.GetFolder(foldername).Subfolders
call ModifyLinks(folder.path)
Next
End Sub
'--------------------------------------------------------------------------
' Function WriteEntry to write change history to logfile in outputfile path
'--------------------------------------------------------------------------
Function WriteEntry
If newlink <> "0" Then
w.WriteLine ("")
w.WriteLine ("| " & ""_
& oldfull & " | ")
w.WriteLine ("" & ""_
& oldlink & " | ")
w.WriteLine ("" & ""_
& newlink & " | ")
w.WriteLine ("
")
oldfull = "0"
newlink = "0"
oldlink = "0"
bgcolor = "white"
End If
End Function
'----------------------------------------------------------------------------
'Function to see if outputfile already exists
'----------------------------------------------------------------------------
Function CheckFileExists(sFileName)
Dim FileSystemObject
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
If (FileSystemObject.FileExists(sFileName)) Then
CheckFileExists = True
Else
CheckFileExists = False
End If
Set FileSystemObject = Nothing
End Function
w.Writeline ("")
'if silent = 2, then it will not open the log file
If Silent <= 1 Then
'set command variable with path in quotes (for long filenames)
Command = Chr(34) & OutputFile & Chr(34)
'run htm file in your default browser
wso.Run Command
End If
'~~[/script]~~