Place shortcut icon to active workbook on desctop

[mnmhenry]

Hi everyone. Can I put a shortcut icon from the active workbook to my desctop ? Aswell an On Error Resume Next if it allready exists ?

Thanks.
Mark Henry

[Ivan F Moala]

On 2002-04-01 02:01, mnmhenry wrote:
Hi everyone. Can I put a shortcut icon from the active workbook to my desctop ? Aswell an On Error Resume Next if it allready exists ?

Thanks.
Mark Henry

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

[Ivan F Moala]

If you need an explaination of the code
the post and I'll explain whats happening.

[mnmhenry]

Wow what do you guys do all day. How can you grasp all this stuff. This is super. Thank you very much. I'll get onto it right away....