Shortcut

a script to create shortcuts

Nowadays, the setup programs that install new software to your computer, create shortcuts in the startup folder and the desktop automatically. However, if you have a collection of older software (games, DOS stuff, ...), you usually don't even need to 'install' anything. You just copy the software to your hard disk, and run the executable, or the batch file that takes care of some configuration settings and then calls the executable.

Result : no shortcuts. You need to find the executable in its program directory to run it. Or you create a shortcut on the desktop and/or in the start menu. But if you have a lot, it gets boring very quickly. So you want to do it (semi-) automatically. You want this script.

'	Koen Noens
'	September 2004
'
'	script to create desktop shortcuts for .bat or .exe files in a
'	given directory and its subdirectories
'	support for .ico files to be used as shortcut icon
'
'	asks confirmation before creating a shortcut

Option Explicit

Dim WSHShell, fso, oArgs
Dim sFirstFolder
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

	sFirstFolder = inputbox("start looking in","Quick Shortcut Tool", "C:\")
	If sFirstFolder <>"" Then
		ProcessFolder(FSO.getfolder(sFirstFolder))
		Wscript.Echo "Finished"
	Else
		Wscript.Quit
	End If

Sub ProcessFolder(objFolder)
	Dim objFile
	Dim objSubFolder
	Dim Reply

	'process the files in this directory
	'note that use of UCASE for case-insensitive match. Old DOS programs seem to have
	'uppercase names/extensions that or not found otherwise.

	For Each objFile in ObjFolder.Files
		If UCase(Right(objFile.Name,4))= ".BAT" OR Ucase(Right(objFile.Name,4)) = ".EXE" Then
			Reply =MsgBox ("create shortcut for " & vbCrLf & objFile.path & " ?", vbOKCancel)
			If Reply = 1 Then
				MakeDesktopShortcut objFile.name, objFile.Path
			End If
		End If
	Next

	'repeat for subfolders
	For Each objSubFolder in objFolder.SubFolders
		ProcessFolder(objSubFolder)
	Next

End Sub

Function MakeDesktopShortcut( name, target)
' largely based on http://www.pcsupportadvisor.com/Windows_scripting_host_page2.htm

	Dim objFolder, objFile
	Dim Shortcut, DesktopPath, StartupPath
	DesktopPath = WSHShell.SpecialFolders("Desktop")

	Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\" & name & ".lnk")
	Shortcut.TargetPath = target
	StartupPath = fso.GetParentFolderName( target )

	If fso.FolderExists( StartupPath ) then
		Shortcut.WorkingDirectory = StartupPath
	End If
	
	'if an icon file exist in the application directory, use that icon
	'is interesting for old dos programs and /or applications started from a bat file
	set objFolder = fso.getfolder(StartupPath)
	For Each objFile in objFolder.Files
		If UCase(Right(objFile.ShortName,4)) = ".ICO" Then
			Shortcut.IconLocation=objFile.Path
			Exit For
		End If
	Next
	Shortcut.Save
End Function

	

So. That's all there is too it.

Silly Software Company -=oOo=-