Change description in shortcut name 2

Jeepix · Jun 9, 2014

Hey, gang...have another cry for help. I have the script below that does what I need, tweaked it to work in my environment, but am stumped on how to change the description of the shortcut.

This does what it should, changing the mapping of the shortcut (in this case on the user's desktop), but the shortcut will still have the old servername in the description, i.e., "Migration Data (oldserverfs01)" instead of the server name path it was changed to "(Migration Data (newserverfs01)", for example.

Also, if you could offer me some help, how do I add multiple locations to search for shortcuts on the client machine? Right now I can only get it to look at their desktop. I'd like to look, say also in their "MyDocuments" and maybe some other places, if possible?

Much thanks in advance for any help! I'm struggling over here! Ugggghh

Script to search and change path of shortcut to new server location, but does not change 'shortcut name'

Dim SearchFor : SearchFor = "\\old_server_name\"
Dim ReplaceWith : ReplaceWith = "\\new_server_name\"
Dim DirectoryPath : DirectoryPath = GetSpecialFolderPath("Desktop")

EnumFolder DirectoryPath
Sub EnumFolder(DirectoryPath)
Dim FSO, Folder, Files, File, ShortcutPath, ShortcutTargetPath
Set FSO = CreateObject("Scripting.FileSystemObject")
If NOT FSO.FolderExists(DirectoryPath) Then Exit Sub

Set Folder = FSO.GetFolder(DirectoryPath) : Set Files = Folder.Files
For Each File in Files
If IsShortcut(File.Path) Then
ShortcutPath = File.Path
ShortcutTargetPath = GetShortcutTargetPath(File.Path)
If ValueMatchesSearchPattern(ShortcutTargetPath, SearchFor) Then
ShortcutTargetPath = GetNewShortcutTargetPath(ShortcutTargetPath)
Call SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
End If

End If

Next
Set File = Nothing
Set Files = Nothing
Set Folder = Nothing
Set FSO = Nothing

End Sub

Function ValueMatchesSearchPattern(SearchValue, SearchPattern)
Dim i
ValueMatchesSearchPattern = False
If Instr(1, SearchValue, SearchPattern, 1) > 0 Then
ValueMatchesSearchPattern = True

End If

End Function

Function GetNewShortcutTargetPath(ShortcutTargetPath)
GetNewShortcutTargetPath = Replace(ShortcutTargetPath, SearchFor, ReplaceWith, 1, 1, 1)

End Function

Function IsShortcut(FilePath)
Dim FileExtension
IsShortcut = False
FileExtension = UCase(Mid(FilePath, InStrRev(FilePath, ".")+1))
If "LNK" = FileExtension Then IsShortcut = True

End Function

Function GetSpecialFolderPath(SpecialFolder)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
GetSpecialFolderPath = WshShell.SpecialFolders(SpecialFolder)
Set WshShell = Nothing

End Function

Function GetShortcutTargetPath(ShortcutPath)
Dim WshShell, Shortcut
Set WshShell = CreateObject("WScript.Shell")
Set Shortcut = WshShell.CreateShortcut(ShortcutPath)
GetShortcutTargetPath = Shortcut.TargetPath
Set Shortcut = Nothing
Set WshShell = Nothing

End Function

Function SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
Dim WshShell, Shortcut
Set WshShell = CreateObject("WScript.Shell")
Set Shortcut = WshShell.CreateShortcut(ShortcutPath)
Shortcut.TargetPath = ShortcutTargetPath
Shortcut.Save
Set Shortcut = Nothing
Set WshShell = Nothing

End Function

VulcanJedi · Jun 9, 2014

isn't the description just
shortcut.description = "A"
shortcut.save
?
Works for me in a dummy test on my VM. The comment field is updated.

Jeepix · Jun 10, 2014

Well, I need it to change it to the variable 'ReplaceWith'. How/where would I stick that into the script so it only changes the specific shortcuts that are being looked for/changed?

Thanks in advance!
-j

guitarzan · Jun 10, 2014

The "how" is the Replace function. This should work.

Code:

Function SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
   Dim WshShell, Shortcut
   Set WshShell = CreateObject("WScript.Shell")
   Set Shortcut = WshShell.CreateShortcut(ShortcutPath)
   Shortcut.TargetPath = ShortcutTargetPath
   [highlight #FCE94F]Shortcut.Description = Replace(Shortcut.Description, SearchFor, ReplaceWith)[/highlight]
   Shortcut.Save
   Set Shortcut = Nothing
   Set WshShell = Nothing

End Function

Jeepix · Jun 10, 2014

Hmmmm...Doesn't seem to change the description of the shortcut. Makes sense that it should, though.

So, just to make sure I explained it correctly, the script changes the mapping as it should, i.e.:
from:
\\serverfs100\sharename
to:
\\serverfs101\sharename

But, I'd like the name of the shortcut to do this:
from:
Migrate (serverfs100)
to:
Migrate (serverfs101)

This way after it's changed it won't show the soon-to-be offline server in the description. Seems kind of silly since the path is correct, but it's what's wanted, if possible.

The change above didn't seem to touch the description at all for some reason.

Thanks in advance!
-j

Jeepix · Jun 10, 2014

Whoa, wait a minute, it did. It's in the 'description' field (when you hit properties and go to 'general' tab, but didn't change the shortcut name that you see under the icon. That's not the description field?

guitarzan · Jun 10, 2014

Oh ok. You just need to rename the shortcut file. I think this would work.

Code:

Sub EnumFolder(DirectoryPath)
   Dim FSO, Folder, Files, File, ShortcutPath, ShortcutTargetPath
   Set FSO = CreateObject("Scripting.FileSystemObject")
   If NOT FSO.FolderExists(DirectoryPath) Then Exit Sub

   Set Folder = FSO.GetFolder(DirectoryPath) : Set Files = Folder.Files
   For Each File in Files
      If IsShortcut(File.Path) Then
         ShortcutPath = File.Path
         ShortcutTargetPath = GetShortcutTargetPath(File.Path)
         If ValueMatchesSearchPattern(ShortcutTargetPath, SearchFor) Then
            ShortcutTargetPath = GetNewShortcutTargetPath(ShortcutTargetPath)
            Call SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
            [highlight #FCE94F]File.Name = Replace(File.Name, SearchValue, SearchPattern)[/highlight]
         End If

      End If

   Next
   Set File = Nothing
   Set Files = Nothing
   Set Folder = Nothing
   Set FSO = Nothing

End Sub

no need to set the description, then

VulcanJedi · Jun 10, 2014

Jeepix how are you doing this vbscripting? Are you using any IDE at all? I think you could save yourself a lot of this heartache
I'd suggests VBSedit, just to get a base, with some samples loaded and an object broswer. It has a trial version.

Jeepix · Jun 10, 2014

Thanks Guitarzan, doing some naming testing I think I might have a limitation on the Windows side.

Since what we're trying to change is a filename, it won't accept the \\ or the trailing \ in the renaming or, of course just naming a file from scratch. Windows just won't have it.

I tried your change, that as always, makes perfect sense, but it gives me an error. But I think the error is bogus because of the above limitation.

I think by using the variable it'd come out like this, no?

from:
Migrate (serverfs100)
to:
Migrate (\\serverfs101\) <--Windows would freak out on that.

I think I'll just talk them out of this modification. Keeping it the same may cause less confusion on the end user's part, ya know? Unless you've got a brilliant idea that doesn't take you a ton of time- you've helped me out a TON already.

Error:
Line: 21
Char: 1
Error: File already exists
Code:800A003A
Source: Microsoft VBScript runtime error.

Thanks again!!!
-j

guitarzan · Jun 10, 2014

Hmm, sorry, I messed up the replace string. And yes, backslashes are illegal for a file name, didn't notice that... they will have to be removed. Let's try that again:

Code:

Sub EnumFolder(DirectoryPath)
   Dim FSO, Folder, Files, File, ShortcutPath, ShortcutTargetPath
   [highlight #FCE94F]Dim sOldServerName, sNewServerName[/highlight]
   Set FSO = CreateObject("Scripting.FileSystemObject")
   If NOT FSO.FolderExists(DirectoryPath) Then Exit Sub

   Set Folder = FSO.GetFolder(DirectoryPath) : Set Files = Folder.Files
   For Each File in Files
      If IsShortcut(File.Path) Then
         ShortcutPath = File.Path
         ShortcutTargetPath = GetShortcutTargetPath(File.Path)
         If ValueMatchesSearchPattern(ShortcutTargetPath, SearchFor) Then
            ShortcutTargetPath = GetNewShortcutTargetPath(ShortcutTargetPath)
            Call SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
            [highlight #FCE94F]sOldServerName = Replace(SearchFor, "\", "")[/highlight]
            [highlight #FCE94F]sNewServerName = Replace(ReplaceWith, "\", "")[/highlight]
            [highlight #FCE94F]File.Name = Replace(File.Name, sOldServerName, sNewServerName)[/highlight]
         End If

      End If

   Next
   Set File = Nothing
   Set Files = Nothing
   Set Folder = Nothing
   Set FSO = Nothing

End Sub

Jeepix · Jun 11, 2014

You nailed it again, guitarzan! If you're ever in So. Cal. the first few rounds are definitely on me.

I had to add some code for that refreshes the desktop for Windows XP. It was changing the name, but because XP wasn't automatically refreshing the .lnk's appeared dead/bad (only certain ones, had to do with how far the shortcut had drilled down). A refresh fixed it.

Here it is for anyone that needs it. Any mapping that is created using the 'create shortcut' method is changed, both the path and the name to the new server on the 'logged in' user's desktop.

Many thanks to guitarzan!!!

Dim SearchFor : SearchFor = "\\old_servername\"
Dim ReplaceWith : ReplaceWith = "\\new_servername\"
Dim DirectoryPath : DirectoryPath = GetSpecialFolderPath("Desktop")
'Dim DirectoryPath : DirectoryPath = GetSpecialFolderPath("MyDocuments")
'Dim DirectoryPath : DirectoryPath = GetSpecialFolderPath("AllUsersDesktop")

EnumFolder DirectoryPath
Sub EnumFolder(DirectoryPath)
Dim sOldServerName, sNewServerName
Set FSO = CreateObject("Scripting.FileSystemObject")
If NOT FSO.FolderExists(DirectoryPath) Then Exit Sub

' Error ignore in certain cases where the link does not have the old servername in the name
On Error Resume Next

Set Folder = FSO.GetFolder(DirectoryPath) : Set Files = Folder.Files
For Each File in Files
If IsShortcut(File.Path) Then
ShortcutPath = File.Path
ShortcutTargetPath = GetShortcutTargetPath(File.Path)
If ValueMatchesSearchPattern(ShortcutTargetPath, SearchFor) Then
ShortcutTargetPath = GetNewShortcutTargetPath(ShortcutTargetPath)
Call SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
sOldServerName = Replace(SearchFor, "\", "")
sNewServerName = Replace(ReplaceWith, "\", "")
File.Name = Replace(File.Name, sOldServerName, sNewServerName)
End If

End If

Next
Set File = Nothing
Set Files = Nothing
Set Folder = Nothing
Set FSO = Nothing

End Sub

' Forces XP desktop to refresh to update shortcut objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
sSCFFile= oFSO.BuildPath(oFSO.GetSpecialFolder(2), oFSO.GetTempName &".scf")
With oFSO.CreateTextFile(sSCFFile, True)
.WriteLine("[Shell]")
.WriteLine("Command=2")
.WriteLine("[Taskbar]")
.WriteLine("Command=ToggleDesktop")
.Close
End With

' Toggle desktop and send F5 (refresh)
With CreateObject("WScript.Shell")
.Run """" & sSCFFile & """"
WScript.Sleep 100
.Sendkeys "{F5}"
End With
' Delete explorer command file
oFSO.DeleteFile sSCFFile

Function ValueMatchesSearchPattern(SearchValue, SearchPattern)
Dim i
ValueMatchesSearchPattern = False
If Instr(1, SearchValue, SearchPattern, 1) > 0 Then
ValueMatchesSearchPattern = True

End If

End Function

Function GetNewShortcutTargetPath(ShortcutTargetPath)
GetNewShortcutTargetPath = Replace(ShortcutTargetPath, SearchFor, ReplaceWith, 1, 1, 1)

End Function

Function IsShortcut(FilePath)
Dim FileExtension
IsShortcut = False
FileExtension = UCase(Mid(FilePath, InStrRev(FilePath, ".")+1))
If "LNK" = FileExtension Then IsShortcut = True

End Function

Function GetSpecialFolderPath(SpecialFolder)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
GetSpecialFolderPath = WshShell.SpecialFolders(SpecialFolder)
Set WshShell = Nothing

End Function

Function GetShortcutTargetPath(ShortcutPath)
Dim WshShell, Shortcut
Set WshShell = CreateObject("WScript.Shell")
Set Shortcut = WshShell.CreateShortcut(ShortcutPath)
GetShortcutTargetPath = Shortcut.TargetPath
Set Shortcut = Nothing
Set WshShell = Nothing

End Function

Function SetShortcutTargetPath(ShortcutPath, ShortcutTargetPath)
Dim WshShell, Shortcut
Set WshShell = CreateObject("WScript.Shell")
Set Shortcut = WshShell.CreateShortcut(ShortcutPath)
Shortcut.TargetPath = ShortcutTargetPath
Shortcut.Save
Set Shortcut = Nothing
Set WshShell = Nothing

End Function

Jeepix · Jul 11, 2014

In doing some pre-run testing of this script we're noticing that there appears to be a case-sensitivity issue when renaming the shortcuts. If the filename of the .lnk has any or all capital letters in the name of the servr (i.e. share on 'Server01') the renaming is ignored becuase the script is looking for "server01" and not "Server01". If I use "Server01" in the script, it replaces the name in the file with the new server name, i.e. server02. Windows usually never had any worries about case sensitivity (linux on the other hand...), so I don't get why it does now.

Is there anyway to prevent this? To have it totally ignore case?

Many thanks in advance!
-j

-Jeepix

PHV · Jul 11, 2014

File.Name = Replace(File.Name, sOldServerName, sNewServerName[!], 1, -1, 1[/!])

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

Jeepix · Jul 11, 2014

PHV- THANK YOU AGAIN! Works awesome!

-Jeepix

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Change description in shortcut name 2

Jeepix

MIS

VulcanJedi

Technical User

Jeepix

MIS

guitarzan

Programmer

Jeepix

MIS

Jeepix

MIS

guitarzan

Programmer

VulcanJedi

Technical User

Jeepix

MIS

guitarzan

Programmer

Jeepix

MIS

Jeepix

MIS

PHV

MIS

Jeepix

MIS

Similar threads

Part and Inventory Search

Sponsor