On 2002-03-02 20:32, jgoulart wrote:
That sounds like a good idea of making it an .exe instead of vba. Do you have any advice on where I can go to learn how to do that?
Thanks,
John
To create a short cut try this code;
Note: If working from another workbook then
remove the ' for the appropriate commands
in the routine Create_Shortcut.
If you need an explanation about the code then post......
Ivan
Option Explicit
Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
(ByVal hwnd As Long, ByVal nFolder As Long, ppidl As Long) As Long
Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long
Declare Function SetWindowPos Lib "User32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal uFlags As Long) As Long
Declare Function SetForegroundWindow Lib "User32" _
(ByVal hwnd As Long) As Long
Declare Function GetForegroundWindow Lib "User32" () As Long
Dim ShortCutExists As Boolean
Dim F_Lnk As String
'
Function CreateShortCut(Target As String) As Boolean
Dim hwnd As Long 'Handle of Window
Dim Pidl As Long
Dim DeskTopSysFile As String
'File exists
If Dir(Target) = "" Then Exit Function
'Get the windows desktop Pidl
SHGetSpecialFolderLocation 0, 0, Pidl
'assign spaces
DeskTopSysFile = Space(260)
'Get the path
SHGetPathFromIDList Pidl, DeskTopSysFile
'Now shorten
DeskTopSysFile = Left(DeskTopSysFile, InStr(1, DeskTopSysFile, vbNullChar) - 1)
'Does Shortcut exist
If Dir(DeskTopSysFile & "" & F_Lnk) <> "" Then ShortCutExists = True: Exit Function
hwnd = GetForegroundWindow
SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
'Run RunDll32.exe - appWiz.Cpl = simulate Right click / Add shortcut
Shell "RunDLL32 AppWiz.Cpl,NewLinkHere " & DeskTopSysFile & ""
'Use send keys to send to ACTIVE application window
SendKeys """" & Target & """~~", True
SetForegroundWindow hwnd
CreateShortCut = True
End Function
Sub Create_Shortcut()
Dim ThisFile As String
'ThisFile = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
ThisFile = ThisWorkbook.Path & "" & ThisWorkbook.Name
'F_Lnk = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name)) & ".LNK"
F_Lnk = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name)) & ".LNK"
' Creates a shortcut to your file ThisFile
MsgBox IIf(CreateShortCut(ThisFile), "CreateShortCut created for: " & ThisFile, _
IIf(ShortCutExists, "Shortcut Already created!", "Can't find the file!"))
End Sub