Massenänderung von Links/Shortcuts/Verknüpfungen unter Windows

Hat man viele Verknüpfungen unter Windows die angepasst werden müssen (z.B. weil sich ein Servername geändert hat) kann man komplett die Chance nutzen, um alles mal aufzuräumen und nur die Links zu ändern die man wirklich noch braucht oder: Man bedient sich eines Automatismus.

Verblüffend wenig habe ich dazu im Internet gefunden und noch weniger davon brauchbares obwohl es doch sicherlich viele Servermigrationen gibt. Ein gute Skript findet man unter:

Hier das Skript (als .vbs speichern und mit ‘wscript’ ausführen) falls der Link oben mal nicht mehr funktionieren sollte (Achtung: Bitte vorher LESEN was man starten möchte und die Variable “silent” auf jeden Fall von 1 auf 0 ändern:

'~~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
'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."'

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

End If

If CheckFolder = "" Then
  If OSType <> "Windows_NT" Then
	'Windows 9x/Me desktop folder
	CheckFolder = Windirectory & "\desktop" 
	'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)
	'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
		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
		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 ("<html>")
	w.Writeline ("<title>Changing Shortcuts in root folder "_
	 & CheckFolder & "</title>")
	w.Writeline ("<table BORDER=0 width=100% cellspacing=0 cellpadding=3>")
	w.Writeline ("<tr>")
	w.Writeline ("<th bgcolor=#000080 colspan=3 width=100>")
	w.Writeline ("<p align=left>")
	w.Writeline ("</th>")
	w.Writeline ("</tr>")
	w.Writeline ("<h0><B><font face=Arial color=#000033 size=2>"_
	& "Shortcuts located in: <font color=#CC0000> "_
	& CheckFolder & " <font face=Arial color=#000033 size=2>,"_
	& " searching recursively at " & CurTime & "</B></font></h0>")
	w.WriteLine ("<TR bgcolor=gray colspan=3 width=100>")
	w.WriteLine ("<TD><font face=Arial size=1 color=white> Shortcut Path"_
	& "</font></TD>")		
	w.WriteLine ("<TD><font face=Arial size=1 color=white> Target Path"_
	& "</font></TD>")
	w.WriteLine ("<TD><font face=Arial size=1 color=white> Updated to"_
	& "</font></TD>")
	w.WriteLine ("</TR>")

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(,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

		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
		'If answer above is anything but yes, the script will proceed 
		' to the next shortcut

		End if
	'Clear link variable
      MyPos = 0
      MyPosEnd = 0
      End if
      'write output to logfile
      Call WriteEntry   
End If


   'process all the subfolders in the folder
   For each folder in fso.GetFolder(foldername).Subfolders
      call ModifyLinks(folder.path)

End Sub

' Function WriteEntry to write change history to logfile in outputfile path 

Function WriteEntry
   If newlink <> "0" Then
	w.WriteLine ("<TR bgcolor=" & Chr(34) & bgcolor & Chr(34) & ">")
	w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
	& oldfull & "</font></TD>")		
	w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
	& oldlink & "</font></TD>")
	w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
	& newlink & "</font></TD>")
	w.WriteLine ("</TR>")
   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
	CheckFileExists = False
End If
Set FileSystemObject = Nothing
End Function

w.Writeline ("</html>")

'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

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert

Time limit is exhausted. Please reload CAPTCHA.