Possible to delete or edit a desktop shortcut?

  • Thread starter Thread starter Marchand Durpis
  • Start date Start date
M

Marchand Durpis

Is there any way in VBA to either totally delete a desktop shortcut,
or to edit the TargetPath of an existing one? I'd like to distribute
an update to an XLS file for which many users already have a shortcut
on their desktop (They haven't put the file on their desktop, just a
shortcut to it). The update will have a different file name than the
existing one. I prefer not to confuse the users by having either
having two almost-the-same icons on their desktop. Nor do I want to
force them to manually delete the existing one and create a "new" one
pointing to the updated file.
So while there's a bunch of code out there - and in this newsgroup -
on how to create a desktop shortcut, I haven't seen any that let's you
find whether a specific shortcut already exists and change its
..TargetPath, or to simply delete it (after which I'd create a totally
new, but visually identical one).
Anyone out there ever done this kind of thing before?

/Marchand/
 
Hi Marchand

No, but there's a first time for everything. Here's a "Delete" code. Provide either the shortcut caption, the file target path or
both (like here in Sub Test):

************************************
Option Explicit 'Top of module !

Public Const CSIDL_DESKTOP = &H0 '{desktop}
Public Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Public Const CSIDL_RECENT = &H8 '{user}\Recent

Public Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Public Declare Function SHGetSpecialFolderLocation Lib "shell32" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long

Public Declare Sub CoTaskMemFree Lib "ole32" _
(ByVal pv As Long)

Dim objWshShell As Object
Dim objShortcut As Object

Function GetSpecialFolderLocation(CSIDL As Long) As String
Dim sPath As String
Dim pidl As Long
If SHGetSpecialFolderLocation(1, CSIDL, pidl) = 0 Then
sPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
GetSpecialFolderLocation = Left(sPath, InStr(sPath, _
Chr$(0)) - 1)
End If
Call CoTaskMemFree(pidl)
End If
End Function

Sub KillLinkFile(DirToSearch As String, _
LinkCaption As String, _
LinkTarget As String)
Dim NextFile As String
Dim l As Long
Dim sTargetPath As String
On Error Resume Next
NextFile = Dir(DirToSearch & "\" & "*.lnk")
Do Until NextFile = ""
Set objShortcut = objWshShell.CreateShortcut(DirToSearch & _
"\" & NextFile)
sTargetPath = objShortcut.TargetPath
If NextFile = LinkCaption & ".lnk" Then
Kill DirToSearch & "\" & NextFile
ElseIf sTargetPath = LinkTarget Then
Kill DirToSearch & "\" & NextFile
End If
Set objShortcut = Nothing
NextFile = Dir()
Loop
End Sub

Sub test()
Set objWshShell = CreateObject("WScript.Shell")
Call KillLinkFile(GetSpecialFolderLocation(&H0), _
"MGP", "C:\Temp\MGP.xls")
End Sub
 
Back
Top