Results 1 to 15 of 15

Thread: What are shortcuts?

  1. #1

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    Well, what are they? I mean, the windows things. lnk files eh? Wossat then? Would some kind person please enlighten me? I should be awfully grateful... Oh yeah, and I'd like to be able to generate/edit them from VBA (Excel again, I'm afraid). That's what I'd really like...

  2. #2
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    Well those *lnk's are real bastards....
    There binaries wich make them hard to generate...

    There is a way to generate them though:
    Code:
    Private Declare Function fCreateShellLink Lib "Vb5stkit.dll" (ByVal _
           lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
           lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
    As you can see it requires Vb5stkit.dll.
    I tried doin it with Vb6stkit.dll but that doesn't work.
    Also put the dll in your app.path...

    Hope this helps

  3. #3

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    Hi you inhuman-oid you, cheers for that but my prob is that I don't have dear old vb5 (or 6) here at work, just VBA. So I guess there's nothing I can do eh? Drat and double-drat. Now THAT kind of language will get you kicked off a forum, eh? How does Windaes (Scottish version) generate them then?

  4. #4
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    Shell links, also known as shortcuts, are a convenient way to reference objects within the shell name space (the hierarchical structure of objects in the Microsoft Windows 95 and Windows 98 shell) without having to keep track of the name and location of the original object. Shell links are referred to as shortcuts in the Context menu (that appears when you right- click an object) of shell objects. They are implemented internally via the IShellLink interface.

    Because they are implemented internally I think it would be very hard (if not impossible) to generate them from VBA.
    As far as editing goes there binaries so that's out of the question unless you like to do some hex-ing

  5. #5
    Guru Yonatan's Avatar
    Join Date
    Apr 1999
    Location
    Israel
    Posts
    892

    Post

    I have a program which tricks the system somehow - so that it doesn't need any setup kit DLLs, and creates a shortcut anywhere without using IShellLink (well, actually the APIs it calls are using it but that's a different story). I'll try to "translate" it to VBA...

    ------------------
    Yonatan
    Teenage Programmer
    E-Mail: RZvika@netvision.net.il
    ICQ: 19552879
    AIM: RYoni69

  6. #6
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    If you feel like it, post the vb-code as well.

    cheers

  7. #7
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    If you feel like it, post the vb-code as well.

    cheers

  8. #8
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    If you feel like it, post the vb-code as well.

    cheers

  9. #9
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    If you feel like it, post the vb-code as well.

    cheers

  10. #10

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    Sounds great, Yonatan. I think Inhumanoid is fairly keen to see the code too (judging by the way he posted his request 4 times)...
    Thanks in advance

    [This message has been edited by coox (edited 11-17-1999).]

  11. #11
    Hyperactive Member
    Join Date
    Oct 1999
    Posts
    309

    Post

    F&*K, something went totally wrong...

    realy sorry.. I hate it when people do this....

    Again sorry

  12. #12
    Guru Yonatan's Avatar
    Join Date
    Apr 1999
    Location
    Israel
    Posts
    892

    Post

    Yeah, it happens... You can delete three of the four messages, you know.

    Ok, I translated it.
    You have two functions to choose from:
    GenerateShortcut and GenerateShortcutByDirName.

    With GenerateShortcut - you can choose a default directory to create the shortcut in.
    With GenerateShortcutByDirName - you can choose a system directory. The parameter sDirName needs to be one of the following:

    Desktop (Virtual)
    Programs
    Controls
    Printers
    Personal
    Favorites
    Startup
    Recent
    Send To
    Recycle Bin
    Start Menu
    Desktop Directory
    My Computer
    Network
    Nethood
    Fonts
    Templates
    Start Menu (Common)
    Programs (Common)
    Startup (Common)
    Desktop Directory (Common)
    Application Data
    PrintHood


    Don't ask me what each one means... This is really old code... Speaking of which, here's the code: (Put it in a module)
    [code]
    Option Explicit
    Option Compare Text


    Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)


    Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hWndOwner As Long, ByVal nFolder As Long, ByVal ppidl As Long) As Long
    Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHAddToRecentDocs Lib "Shell32" (ByVal uFlags As Long, pv As Any) As Long
    Private Declare Function SHFileOperation Lib "Shell32" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long


    Private Const FO_MOVE = &H1
    Private Const FO_RENAME = &H4
    Private Const FOF_SILENT = &H4
    Private Const FOF_RENAMEONCOLLISION = &H8
    Private Const MAX_PATH As Integer = 260
    Private Const SHARD_PATH = &H2&


    Private Const CSIDL_DESKTOP = &H0
    Private Const CSIDL_PROGRAMS = &H2
    Private Const CSIDL_CONTROLS = &H3
    Private Const CSIDL_PRINTERS = &H4
    Private Const CSIDL_PERSONAL = &H5
    Private Const CSIDL_FAVORITES = &H6
    Private Const CSIDL_STARTUP = &H7
    Private Const CSIDL_RECENT = &H8
    Private Const CSIDL_SENDTO = &H9
    Private Const CSIDL_BITBUCKET = &HA
    Private Const CSIDL_STARTMENU = &HB
    Private Const CSIDL_DESKTOPDIRECTORY = &H10
    Private Const CSIDL_DRIVES = &H11
    Private Const CSIDL_NETWORK = &H12
    Private Const CSIDL_NETHOOD = &H13
    Private Const CSIDL_FONTS = &H14
    Private Const CSIDL_TEMPLATES = &H15
    Private Const CSIDL_COMMON_STARTMENU = &H16
    Private Const CSIDL_COMMON_PROGRAMS = &H17
    Private Const CSIDL_COMMON_STARTUP = &H18
    Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    Private Const CSIDL_APPDATA = &H1A
    Private Const CSIDL_PRINTHOOD = &H1B


    Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS
    End Type


    Private Function GetFolderDir(ByVal CSIDL As Long) As String
    Dim sPath As String
    Dim IDL As Long
    GetFolderDir = ""
    If SHGetSpecialFolderLocation(0, CSIDL, IDL) = 0 Then
    sPath = Space(MAX_PATH)
    If SHGetPathFromIDList(IDL, sPath) Then GetFolderDir = Left(sPath, InStr(sPath, vbNullChar) - 1) & "\"
    End If
    End Function


    Private Function GetCSIDLFromText(ByVal CSIDL As String) As Long
    Select Case CSIDL
    Case "Desktop (Virtual)"
    GetCSIDLFromText = CSIDL_DESKTOP
    Case "Programs"
    GetCSIDLFromText = CSIDL_PROGRAMS
    Case "Controls"
    GetCSIDLFromText = CSIDL_CONTROLS
    Case "Printers"
    GetCSIDLFromText = CSIDL_PRINTERS
    Case "Personal"
    GetCSIDLFromText = CSIDL_PERSONAL
    Case "Favorites"
    GetCSIDLFromText = CSIDL_FAVORITES
    Case "Startup"
    GetCSIDLFromText = CSIDL_STARTUP
    Case "Recent"
    GetCSIDLFromText = CSIDL_RECENT
    Case "Send To"
    GetCSIDLFromText = CSIDL_SENDTO
    Case "Recycle Bin"
    GetCSIDLFromText = CSIDL_BITBUCKET
    Case "Start Menu"
    GetCSIDLFromText = CSIDL_STARTMENU
    Case "Desktop Directory"
    GetCSIDLFromText = CSIDL_DESKTOPDIRECTORY
    Case "My Computer"
    GetCSIDLFromText = CSIDL_DRIVES
    Case "Network"
    GetCSIDLFromText = CSIDL_NETWORK
    Case "NetHood"
    GetCSIDLFromText = CSIDL_NETHOOD
    Case "Fonts"
    GetCSIDLFromText = CSIDL_FONTS
    Case "Templates"
    GetCSIDLFromText = CSIDL_TEMPLATES
    Case "Start Menu (Common)"
    GetCSIDLFromText = CSIDL_COMMON_STARTMENU
    Case "Programs (Common)"
    GetCSIDLFromText = CSIDL_COMMON_PROGRAMS
    Case "Startup (Common)"
    GetCSIDLFromText = CSIDL_COMMON_STARTUP
    Case "Desktop Directory (Common)"
    GetCSIDLFromText = CSIDL_COMMON_DESKTOPDIRECTORY
    Case "Application Data"
    GetCSIDLFromText = CSIDL_APPDATA
    Case "PrintHood"
    GetCSIDLFromText = CSIDL_PRINTHOOD
    Case Else
    Call Err.Raise(Number:=380, Description:="Invalid Directory Name.")
    End Select
    End Function


    Public Sub GenerateShortcut(Optional ByVal sDefaultDirPath As String = vbNullString)
    Dim sPath As String
    Dim lRet As Long
    sPath = InputBox("Enter directory to make shortcut in:", "Enter Directory", IIf(sDefaultDirPath = vbNullString, Empty, sDefaultDirPath))
    If sPath = "" Then Exit Sub
    Call HandleCreateShortcutError(CreateShortcut(sPath))
    End Sub


    Public Sub GenerateShortcutByDirName(ByVal sDirName As String)
    Call HandleCreateShortcutError(CreateShortcut(GetFolderDir(GetCSIDLFromText(sDirName))))
    End Sub


    Private Sub HandleCreateShortcutError(ByVal lErr As Long)
    If lErr = 0 Then Exit Sub
    If lErr <> -1 Then
    Call MsgBox("Error " & lErr & ": " & Error(lErr), vbCritical Or vbSystemModal, App.Title & " - Error")
    Else
    Call MsgBox("Shortcut successfully created!", vbExclamation, App.Title & App.Title & " - Success")
    End If
    End Sub


    Private Function CreateShortcut(ByVal sPath As String) As Long
    Dim I As Integer
    Dim sFilePath As String
    Dim sFileName As String
    Dim sShortcutName As String
    Dim sRecentPath As String
    Dim lResult As Long
    Dim SHFileOp As SHFILEOPSTRUCT
    On Error GoTo ErrorHandler
    If Dir(sPath) = "" Then Call MkDir(sPath)
    sFilePath = InputBox("Enter file name to create a shortcut to:", "Enter File Name", "C:\Windows\Explorer.Exe")
    If sFilePath = "" Then Exit Function
    sShortcutName = InputBox("Enter file name of the shortcut to create in " & sPath & ":", "Enter File Name", "Shortcut.Lnk")
    If sShortcutName = "" Then Exit Function
    If Not Right(LCase(sShortcutName), 4) = ".lnk" Then
    sShortcutName = sShortcutName & ".Lnk"
    Call MsgBox("The file name didn't have the .Lnk extension. It has been added." & vbNewLine & _
    "The file name is now " & sShortcutName & ".", vbExclamation, App.Title & " - Wrong Or No Extension")
    End If
    Screen.MousePointer = vbHourglass
    DoEvents ' For Screen.MousePointer
    If Not GetFolderDir(CSIDL_RECENT) = "" Then
    lResult = SHAddToRecentDocs(SHARD_PATH, ByVal sFilePath)
    Call Sleep(100)
    If lResult Then
    I = 1
    sFileName = sFilePath
    Do While I
    I = InStr(1, sFileName, "\")
    If I Then sFileName = Mid(sFileName, I + 1)
    Loop
    With SHFileOp
    .wFunc = FO_MOVE
    .pFrom = GetF

  13. #13
    Junior Member
    Join Date
    Jan 1999
    Posts
    26

    Post


  14. #14

    Thread Starter
    Fanatic Member coox's Avatar
    Join Date
    Oct 1999
    Posts
    550

    Post

    Thanks Yonatan, only prob I have is with a little thing App.Title - App doesn't seem to exist in my ver of VBA. Any thoughts?

  15. #15
    Guru Yonatan's Avatar
    Join Date
    Apr 1999
    Location
    Israel
    Posts
    892

    Post

    It's not important... Remove it.

    For example, change:

    App.Title & " - Success"

    To:

    "Success"

    ------------------
    Yonatan
    Teenage Programmer
    E-Mail: RZvika@netvision.net.il
    ICQ: 19552879
    AIM: RYoni69

Posting Permissions

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



Click Here to Expand Forum to Full Width