Solved

VB Script for Renaming LNK target and working directory

Posted on 2015-02-10
10
146 Views
Last Modified: 2015-02-11
Hi there,

I need a vbscript that will rename the target and working directory in LNK files located in a folder and its sub-folders.

It will be called from a batch file.

cscript //nologo RenameLnkFiles.vbs "C:\My Documents" "\\server1" "\\server2"
"C:\My Documents" = Working folder (including its subfolders)
"\\server1" = Replace this from all UNCs by "\\server2"

I hope I express my need clearly ennough.  If you have any questions, please let me know.

Thanks for your help,
Rene
0
Comment
Question by:ReneGe
  • 7
  • 3
10 Comments
 
LVL 84

Accepted Solution

by:
oBdA earned 500 total points
ID: 40602596
Try this; it's currently in test mode and will not save the updated shortcuts. Uncomment line 26 to run it for real.
strSourceFolder = WScript.Arguments(0)
strFind = WScript.Arguments(1)
strReplaceWith = WScript.Arguments(2)

Sub ReplaceInShortcutRecurse(objStartFolder, strFind, strReplaceWith)
	Set objThisFolder = objFSO.GetFolder(objStartFolder.Path)
	Set colFiles = objThisFolder.Files
	On Error Resume Next
	For Each objFile in colFiles
		If Err.Number <> 0 Then
			Err.Clear
		Else
			bSave = False
			If UCase(objFSO.GetExtensionName(objFile.Path)) = "LNK" Then
				Wscript.StdOut.Write "Processing '" & objFile.Path & "' ... "
				Set objShortcut = objWSH.CreateShortcut(objFile.Path)
				If InStr(objShortcut.TargetPath, strFind) <> 0 Then
					objShortcut.TargetPath = Replace(objShortcut.TargetPath, strFind, strReplaceWith)
					bSave = True
				End If
				If InStr(objShortcut.WorkingDirectory, strFind) <> 0 Then
					objShortcut.WorkingDirectory = Replace(objShortcut.WorkingDirectory, strFind, strReplaceWith)
					bSave = True
				End If
				If bSave Then
					' objShortcut.Save()
					If Err.Number <> 0 Then
						Wscript.StdOut.WriteLine
						WScript.StdOut.WriteLine "ERROR " & Err.Number & ": " & Err.Description
						Err.Clear
					Else
						Wscript.StdOut.WriteLine "updated."
					End If
				Else
					Wscript.StdOut.WriteLine "search string not found."
				End If
			End If
		End If
	Next
	For Each objSubfolder in objStartFolder.SubFolders
		If Err.Number <> 0 Then
			Err.Clear
		Else
			Call ReplaceInShortcutRecurse(objSubfolder, strFind, strReplaceWith)
		End If
	Next
	On Error Goto 0
End Sub

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSH = CreateObject("Wscript.Shell")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Call ReplaceInShortcutRecurse(objSourceFolder, strFind, strReplaceWith)

Open in new window

0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603102
Hey oBda :) Its been a while!

Thanks a lot for your help.

I un-commented line 26.

LNK target nor their working dir was not changed.

Here is my output.

C:\BatchFiles\Replace LNK>C:\Windows\System32\cscript.exe //nologo "C:\BatchFiles\Replace LNK\ReplaceLNK.vbs" "C:\BatchFiles\Replace LNK" "C:\BatchFiles\Replace LNK\1" "C:\BatchFiles\Replace LNK\2"
Processing 'C:\BatchFiles\Replace LNK\Shortcuts\File1.txt.lnk' ... search string not found.
Processing 'C:\BatchFiles\Replace LNK\Shortcuts\File2.txt.lnk' ... search string not found.

Cheers,
Rene
0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603123
For your conveniance, here is the dir of that folder.

C:\BatchFiles\Replace LNK\1
C:\BatchFiles\Replace LNK\2
C:\BatchFiles\Replace LNK\ReplaceLNK.bat
C:\BatchFiles\Replace LNK\ReplaceLNK.vbs
C:\BatchFiles\Replace LNK\Shortcuts
C:\BatchFiles\Replace LNK\Shortcuts\File1.txt.lnk
C:\BatchFiles\Replace LNK\Shortcuts\File2.txt.lnk
C:\BatchFiles\Replace LNK\1\File1.txt
C:\BatchFiles\Replace LNK\1\File2.txt
C:\BatchFiles\Replace LNK\2\File1.txt
C:\BatchFiles\Replace LNK\2\File2.txt

So basically, the vbscript as executed from the command line, should replace the "target" and "working directory" of both "File1.txt.lnk" and "File2.txt.lnk" to point to the folder "C:\BatchFiles\Replace LNK\2"

Thanks
0
Space-Age Communications Transitions to DevOps

ViaSat, a global provider of satellite and wireless communications, securely connects businesses, governments, and organizations to the Internet. Learn how ViaSat’s Network Solutions Engineer, drove the transition from a traditional network support to a DevOps-centric model.

 
LVL 84

Expert Comment

by:oBdA
ID: 40603185
This now supports a debug mode where it prints out what happened:
strSourceFolder = WScript.Arguments(0)
strFind = WScript.Arguments(1)
strReplaceWith = WScript.Arguments(2)
bDebug = True

Sub ReplaceInShortcutRecurse(objStartFolder, strFind, strReplaceWith)
	Set objThisFolder = objFSO.GetFolder(objStartFolder.Path)
	Set colFiles = objThisFolder.Files
	On Error Resume Next
	For Each objFile in colFiles
		If Err.Number <> 0 Then
			Err.Clear
		Else
			bSave = False
			If UCase(objFSO.GetExtensionName(objFile.Path)) = "LNK" Then
				Wscript.StdOut.Write "Processing '" & objFile.Path & "' ... "
				Set objShortcut = objWSH.CreateShortcut(objFile.Path)
				strOldTargetPath = objShortcut.TargetPath
				If InStr(objShortcut.TargetPath, strFind) <> 0 Then
					strNewTargetPath = Replace(strOldTargetPath, strFind, strReplaceWith)
					objShortcut.TargetPath = strNewTargetPath
					bSave = True
				Else
					strNewTargetPath = objShortcut.TargetPath
				End If
				strOldWorkingDirectory = objShortcut.WorkingDirectory
				If InStr(objShortcut.WorkingDirectory, strFind) <> 0 Then
					strNewWorkingDirectory = Replace(objShortcut.WorkingDirectory, strFind, strReplaceWith)
					objShortcut.WorkingDirectory = strNewWorkingDirectory
					bSave = True
				Else
					strNewWorkingDirectory = objShortcut.WorkingDirectory
				End If
				If bSave Then
					objShortcut.Save()
					If Err.Number <> 0 Then
						Wscript.StdOut.WriteLine
						WScript.StdOut.WriteLine "ERROR " & Err.Number & ": " & Err.Description
						Err.Clear
					Else
						Wscript.StdOut.WriteLine "updated."
					End If
					If bDebug Then
						Wscript.StdOut.WriteLine vbTab & "Target path: '" & strOldTargetPath & "' --> '" & strNewTargetPath & "'"
						Wscript.StdOut.WriteLine vbTab & "Working dir: '" & strOldWorkingDirectory & "' --> '" & strNewWorkingDirectory & "'"
					End If
				Else
					Wscript.StdOut.WriteLine "search string not found."
					If bDebug Then
						Wscript.StdOut.WriteLine vbTab & "Target path: '" & objShortcut.TargetPath & "'"
						Wscript.StdOut.WriteLine vbTab & "Working dir: '" & objShortcut.WorkingDirectory & "'"
					End If
				End If
			End If
		End If
	Next
	For Each objSubfolder in objStartFolder.SubFolders
		If Err.Number <> 0 Then
			Err.Clear
		Else
			Call ReplaceInShortcutRecurse(objSubfolder, strFind, strReplaceWith)
		End If
	Next
	On Error Goto 0
End Sub

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSH = CreateObject("Wscript.Shell")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Wscript.StdOut.WriteLine "Search string: '" & strFind & "'"
Wscript.StdOut.WriteLine "Replace with:  '" & strReplaceWith & "'"
Call ReplaceInShortcutRecurse(objSourceFolder, strFind, strReplaceWith)

Open in new window

0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603273
Search string: 'C:\BatchFiles\Replace LNK\1'
Replace with:  'C:\BatchFiles\Replace LNK\2'
Processing 'C:\BatchFiles\Replace LNK\Shortcuts\File1.txt.lnk' ... search string not found.
      Target path: 'C:\TEST\Replace LNK\1\File1.txt'
      Working dir: 'C:\TEST\Replace LNK\1'
Processing 'C:\BatchFiles\Replace LNK\Shortcuts\File2.txt.lnk' ... search string not found.
      Target path: 'C:\TEST\Replace LNK\1\File2.txt'
      Working dir: 'C:\TEST\Replace LNK\1'
0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603282
Oops, one moment
0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603299
Sorry about that, this was my mistake.
Your script was working from the start.
I forgot to update the UNCs after moving the files :(

Thanks oBda!

Your script is working like a charm.

Cheers mate :)

Rene
0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603508
Hi oBda

I found that the search is case sensitive.

Can you please tell me how can we make it not case sensitive?

Thanks,
Rene
0
 
LVL 84

Expert Comment

by:oBdA
ID: 40603543
strSourceFolder = WScript.Arguments(0)
strFind = WScript.Arguments(1)
strReplaceWith = WScript.Arguments(2)
bDebug = True

Sub ReplaceInShortcutRecurse(objStartFolder, strFind, strReplaceWith)
	Set objThisFolder = objFSO.GetFolder(objStartFolder.Path)
	Set colFiles = objThisFolder.Files
	On Error Resume Next
	For Each objFile in colFiles
		If Err.Number <> 0 Then
			Err.Clear
		Else
			bSave = False
			If UCase(objFSO.GetExtensionName(objFile.Path)) = "LNK" Then
				Wscript.StdOut.Write "Processing '" & objFile.Path & "' ... "
				Set objShortcut = objWSH.CreateShortcut(objFile.Path)
				strOldTargetPath = objShortcut.TargetPath
				If InStr(1, objShortcut.TargetPath, strFind, 1) <> 0 Then
					strNewTargetPath = Replace(strOldTargetPath, strFind, strReplaceWith, 1, -1, 1)
					objShortcut.TargetPath = strNewTargetPath
					bSave = True
				Else
					strNewTargetPath = objShortcut.TargetPath
				End If
				strOldWorkingDirectory = objShortcut.WorkingDirectory
				If InStr(1, objShortcut.WorkingDirectory, strFind, 1) <> 0 Then
					strNewWorkingDirectory = Replace(objShortcut.WorkingDirectory, strFind, strReplaceWith, 1, -1, 1)
					objShortcut.WorkingDirectory = strNewWorkingDirectory
					bSave = True
				Else
					strNewWorkingDirectory = objShortcut.WorkingDirectory
				End If
				If bSave Then
					objShortcut.Save()
					If Err.Number <> 0 Then
						Wscript.StdOut.WriteLine
						WScript.StdOut.WriteLine "ERROR " & Err.Number & ": " & Err.Description
						Err.Clear
					Else
						Wscript.StdOut.WriteLine "updated."
					End If
					If bDebug Then
						Wscript.StdOut.WriteLine vbTab & "Target path: '" & strOldTargetPath & "' --> '" & strNewTargetPath & "'"
						Wscript.StdOut.WriteLine vbTab & "Working dir: '" & strOldWorkingDirectory & "' --> '" & strNewWorkingDirectory & "'"
					End If
				Else
					Wscript.StdOut.WriteLine "search string not found."
					If bDebug Then
						Wscript.StdOut.WriteLine vbTab & "Target path: '" & objShortcut.TargetPath & "'"
						Wscript.StdOut.WriteLine vbTab & "Working dir: '" & objShortcut.WorkingDirectory & "'"
					End If
				End If
			End If
		End If
	Next
	For Each objSubfolder in objStartFolder.SubFolders
		If Err.Number <> 0 Then
			Err.Clear
		Else
			Call ReplaceInShortcutRecurse(objSubfolder, strFind, strReplaceWith)
		End If
	Next
	On Error Goto 0
End Sub

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSH = CreateObject("Wscript.Shell")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Wscript.StdOut.WriteLine "Search string: '" & strFind & "'"
Wscript.StdOut.WriteLine "Replace with:  '" & strReplaceWith & "'"
Call ReplaceInShortcutRecurse(objSourceFolder, strFind, strReplaceWith)

Open in new window

0
 
LVL 10

Author Comment

by:ReneGe
ID: 40603561
Thank you so much!

Cheers mate :)
Rene
0

Featured Post

Space-Age Communications Transitions to DevOps

ViaSat, a global provider of satellite and wireless communications, securely connects businesses, governments, and organizations to the Internet. Learn how ViaSat’s Network Solutions Engineer, drove the transition from a traditional network support to a DevOps-centric model.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Being a system administrator some time we require to do things remotely, one of them is installing software. Here I am going to tell you how to install software through wmic (Windows management instrument console). I am not at all saying that this i…
How to remove superseded packages in windows w60 or w61 installation media (.wim) or online system to prevent unnecessary space. w60 means Windows Vista or Windows Server 2008. w61 means Windows 7 or Windows Server 2008 R2. There are various …
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question