Option Explicit
‘//—————————————————————————————
‘// Project   : WinXPQuickLaunchToolbar
‘// DateTime  : 28/08/2005 18:22
‘// Author    : Ivan F Moala
‘// Site      : http://www.xcelfiles.com
‘// Purpose   : Add Application EXE to the Quick Launch Toolbar
‘// For OS    : WinXP
‘// Tested    : Tested Xl2000
‘// In        : Path to executable
‘//           :
‘//           :
‘// Out/Return: Quick launch shortcut
‘//—————————————————————————————

Public Enum eWinStyle
    eNormal = 1 ‘// Restores Window to its original size and position.
   eMax = 3    ‘// Displays Window as a maximized window.
   eMin = 7    ‘// Minimizes the Window and activates the next top-level window.
End Enum

Public Enum tHotKey
    tCTRL = 1  ‘// CTRL
   tALT = 2   ‘// ALT
   tSHIFT = 4 ‘// SHIFT
End Enum

Public Function fnCreateQuickLaunchToolBarShortCut( _
    strPathToEXE As String, _
    Optional strLnkName As String, _
    Optional strDescription As String, _
    Optional strArguments As String = vbNullString, _
    Optional strWindowsStyle As eWinStyle, _
    Optional strIconLocation As String, _
    Optional strTargetPath As String = vbNullString, _
    Optional HotKey1 As tHotKey, _
    Optional strHotKeyLetter As String = “”, _
    Optional strWorkingDirectory As String = vbNullString)
   
Dim objShell As Object, objLnk As Object
Dim strLnkPath As String, strAppDataDir As String
Dim strExe As String

Set objShell = CreateObject(“WScript.Shell”)

‘// Prepare the path to the Quick Launch folder
‘// Note: AppData is missing from CHM File help! it is NOT mentioned.
strAppDataDir = objShell.SpecialFolders(“AppData”)
strLnkPath = strAppDataDir & “MicrosoftInternet ExplorerQuick Launch”

‘// Note:If duplicate link name then it replaces it.
‘// set Link name otherwise default to the App Name
If strLnkName = “” Then strLnkName = fnExeName(strPathToEXE)
‘// Set Hot key combination Letter
If HotKey1 > 0 Then
    If strHotKeyLetter = “” Then GoTo NoHotKeyLetter
    strHotKeyLetter = fnGetHotKeyCombString(ByVal HotKey1) & “+” & strHotKeyLetter
End If

‘// Creates the shortcut
Set objLnk = objShell.CreateShortcut(strLnkPath & “” & strLnkName & “.lnk”)

With objLnk
    .TargetPath = strPathToEXE ‘”C:Program FilesMicrosoft OfficeOfficeexcel.exe”
   .WindowStyle = strWindowsStyle ‘1,3,7
   .HotKey = strHotKeyLetter  ‘ eg > “CTRL+ALT+SHIFT+h”
   .WorkingDirectory = strWorkingDirectory ‘”C:ExcelFilesUseful”
   ‘// used 0 index for icon, you can change this IF there are more then 1 and you want to use another.
   .IconLocation = strIconLocation & “,0” ‘”C:Program FilesMicrosoft OfficeOfficeexcel.exe, 0″
   ‘// Note: you could have added the arguments to the Target path with a Space between
   .Arguments = strArguments     ‘Load this up “C:ExcelFilesUseful22.xls”
   .Description = strDescription ‘”My Shortcut to Excel”
   .Save
End With

Set objShell = Nothing
Set objLnk = Nothing

Exit Function
NoHotKeyLetter:
MsgBox “You have NOT defined a hotkey letter!”, vbCritical
End Function

Public Function fnGetHotKeyCombString(ByVal HotKey1 As Integer) As String
‘// Return the HotKey combination
‘// 1=CTRL 2=ALT 4=SHIFT + combinations
Select Case HotKey1
    Case 1
        fnGetHotKeyCombString = “CTRL”
    Case 2
        fnGetHotKeyCombString = “ALT”
    Case 3
        fnGetHotKeyCombString = “CTRL+ALT”
    Case 4
        fnGetHotKeyCombString = “SHIFT”
    Case 5
        fnGetHotKeyCombString = “CTRL+SHIFT”
    Case 6
        fnGetHotKeyCombString = “ALT+SHIFT”
    Case 7
        fnGetHotKeyCombString = “CTRL+ALT+SHIFT”
    Case Else
        fnGetHotKeyCombString = vbNullString
End Select

End Function

Public Function fnExeName(strPath As String) As String
‘// return the Executable name only given the fullpath
Dim vArray As Variant

vArray = Split(strPath, “”)
fnExeName = vArray(UBound(vArray))

End Function

‘// Test routines

Sub Tester1()
‘// Test create launch for Excel
fnCreateQuickLaunchToolBarShortCut _
    Application.Path & “Excel.exe” _
    , “MyExcel”, “This is my version of Excel”, , eMax

End Sub

Sub CreateCab()
‘// Try this !
fnCreateQuickLaunchToolBarShortCut “C:WINDOWSsystem32iexpress.exe”
End Sub