Option Explicit
On Error Resume Next
Dim objFSO, objProfileFolder, objFolder, wshShell
Dim strDesktopPath1, strDesktopPath2, strDesktopPath3, strFilePath, strShortCut, strProfile, strProfileRoot
 
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strShortCut = "yourshortcutname.url/lnk"
strDesktopPath1 = wshShell.SpecialFolders("AllUsersDesktop")
strDesktopPath2 = WshShell.ExpandEnvironmentStrings("%allusersprofile%")&"\desktop"
strDesktopPath3 = wshShell.SpecialFolders("Desktop")
strProfile = wshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strProfileRoot = objFSO.GetFolder(strProfile).ParentFolder.Path
 
Set objProfileFolder = objFSO.GetFolder(strProfileRoot)
 
For Each objFolder in objProfileFolder.SubFolders
  strFilePath = objFolder.Path & "\Desktop\" & strShortCut
'  MsgBox "Testing to see if " & strFilePath & " exists..."
  If objFSO.FileExists(strFilePath) Then
'    MsgBox "Shortcut exists. Deleting..."
    objFSO.DeleteFile strFilePath
  End If
Next
 
Set wshShell = Nothing
Set objFSO = Nothing
Set objProfileFolder = Nothing
Set objFolder = Nothing