• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 213
  • Last Modified:

VB Script for Renaming LNK target and working directory

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
ReneGe
Asked:
ReneGe
  • 7
  • 3
1 Solution
 
oBdACommented:
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
 
ReneGeAuthor Commented:
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
 
ReneGeAuthor Commented:
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
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
oBdACommented:
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
 
ReneGeAuthor Commented:
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
 
ReneGeAuthor Commented:
Oops, one moment
0
 
ReneGeAuthor Commented:
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
 
ReneGeAuthor Commented:
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
 
oBdACommented:
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
 
ReneGeAuthor Commented:
Thank you so much!

Cheers mate :)
Rene
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 7
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now