Solved

VB Script for Renaming LNK target and working directory

Posted on 2015-02-10
10
147 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Major Incident Management Communications

Major incidents and IT service outages cost companies millions. Often the solution to minimizing damage is automated communication. Find out more in our Major Incident Management Communications infographic.

Question has a verified solution.

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

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

737 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