Solved

VB Script for Renaming LNK target and working directory

Posted on 2015-02-10
10
142 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 83

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
 
LVL 83

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
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
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 83

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

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 …
Introduction: Recently, I got a requirement to zip all files individually with batch file script in Windows OS. I don't know much about scripting, but I searched Google and found a lot of examples and websites to complete my task. Finally, I was ab…
In this video I am going to show you how to back up and restore Office 365 mailboxes using CodeTwo Backup for Office 365. Learn more about the tool used in this video here: http://www.codetwo.com/backup-for-office-365/ (http://www.codetwo.com/ba…
Learn how to create flexible layouts using relative units in CSS.  New relative units added in CSS3 include vw(viewports width), vh(viewports height), vmin(minimum of viewports height and width), and vmax (maximum of viewports height and width).

863 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now