Create Desktop Shortcuts

[xxgeek]

[EDIT] - A new version posted with a GUI In This Thread

The following code is meant more as an example to be used in code to create desktop shortcuts. As is it creates a shortcut to a user selected file on the desktop.

Opens to a filedialog to select a file.
Then a shortcut to that file is placed on the desktop.
The code writes/runs a VB script to create the shortcut.

This is a more versatile adaptation of the script used in BAS2EXE to create the desktop shortcut.

    'Make Desktop Shortcut using VB Script
   'by xxgeek
   'Nov 2023
   'an example to use in code to create desktop shorcuts
nomainwin
   filedialog "Select File to Create Shorcut on Desktop", DefaultDir$;"*\*", filepath$
   GetFilename$ = GetFilename$(filepath$)
   nameOffile$ = GetFilename$
   nameOffile$ = left$(GetFilename$, len(GetFilename$)-4)'assumes extension is 3 characters
   call MDS
   end

   'write/run a vbs script to create a desktop shortcut to the selected file
sub MDS
   q$=chr$(34)
   global filepath$, nameOffile$
   desktopShortcut$ = "desktopShortcut.vbs"
   open desktopShortcut$ for output as #1
   #1 "Set Shell = CreateObject(";q$;"WScript.Shell";q$;")"
   #1 "DesktopPath = Shell.SpecialFolders(";q$;"Desktop";q$;")"
   #1 "Set link = Shell.CreateShortcut(DesktopPath & ";q$;"\";nameOffile$;".lnk";q$;")"
   #1 "link.Description = ";q$;nameOffile$;" shortcut";q$
   #1 "link.HotKey = ";q$;"CTRL+ALT+E";q$
   #1 "link.TargetPath = ";q$;filepath$;q$
   #1 "link.WindowStyle = 3"
   #1 "link.Save"
   #1 "Set link = nothing"
   #1 "Set Shell = nothing"
   close #1
   run "wscript ";desktopShortcut$
end sub

function GetFilename$(fileName$)
   i = len(fileName$)
   while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
       i = i-1
   wend
   GetFilename$ = mid$(fileName$, i+1)
end function


[xxgeek]

A couple of updates to the code

- fixed an issue where if a user cancels the filedialog an empty shortcut was being created on the desktop.
- removed the code that makes Ctrl+Alt+E a hotkey to open the file pointed to.
#1 "link.HotKey = ";q$;"CTRL+ALT+E";q$
If a hot key is desired, add the above line, and change the "E" to the hotkey of your choice.
''add it above the "TargetPath" line eg

#1 "link.HotKey = ";q$;"CTRL+ALT+E";q$  'change the "E" to an appropriate letter.
#1 "link.TargetPath = ";q$;filepath$;q$

Added a file check to remove the vb script when complete.
Also added a pause for slower machines in case it's needed.


   'Make Desktop Shortcut using VB Script
   'by xxgeek
   'Nov 2023
   'an example to use in code to create desktop shorcuts
'opens to a dialog to choose a file
'Then creates a shortcut the selected file on the desktop.
   nomainwin
   filedialog "Select File to Create Shorcut on Desktop", DefaultDir$;"*\*", filepath$
   if filepath$ <> "" then
       nameOffile$ = GetFilename$(filepath$)
       nameOffile$ = upper$(left$(nameOffile$, len(nameOffile$)-4))'assumes extension is 3 characters
       call MDS
       call pause 500
       if fileExists(DefaultDir$, "desktopShortcut.vbs") then kill DefaultDir$;"\desktopShortcut.vbs"
   end if
   end

   'write/run a vbs script to create a desktop shortcut to selected file
sub MDS
   q$=chr$(34)
   global filepath$, nameOffile$
   desktopShortcut$ = "desktopShortcut.vbs"
   open desktopShortcut$ for output as #1
   #1 "Set Shell = CreateObject(";q$;"WScript.Shell";q$;")"
   #1 "DesktopPath = Shell.SpecialFolders(";q$;"Desktop";q$;")"
   #1 "Set link = Shell.CreateShortcut(DesktopPath & ";q$;"\";nameOffile$;".lnk";q$;")"
   #1 "link.Description = ";q$;"Shortcut to  ";filepath$;q$
   #1 "link.TargetPath = ";q$;filepath$;q$
   #1 "link.Save"
   #1 "Set link = nothing"
   #1 "Set Shell = nothing"
   close #1
   run "wscript ";desktopShortcut$
end sub

' sub to separate filename from full path
function GetFilename$(fileName$)
   i = len(fileName$)
   while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
       i = i-1
   wend
   GetFilename$ = mid$(fileName$, i+1)
end function

'sub to  create pauses in program
sub pause mil
   t=time$("ms")+mil
   while time$("ms")<t
       scan
   wend
end sub

'function for checking file existence
function fileExists(path$, filename$)
   dim info$(0, 0)
   files path$, filename$, info$()
   fileExists = val(info$(0, 0)) 'non zero is true
end function