Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: Place shortcut icon to active workbook on desctop

  1. #1
    Board Regular
    Join Date
    Mar 2002
    Posts
    164
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  2. #2
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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



    Kind Regards,
    Ivan F Moala From the City of Sails

  3. #3
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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


    Kind Regards,
    Ivan F Moala From the City of Sails

  4. #4
    Board Regular
    Join Date
    Mar 2002
    Posts
    164
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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....

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •