shelllink.txt

一部分关于VB编程的小技巧

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, _
ppidl As Long) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal szPath As String) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Few API calls needed by the below

Public Sub MakeShortcut(ShortCut_PathAndName As String, TargetApp_PathAndName As String, TargetFolder As String)
    Dim objShortcut As Object, objWshShell As IWshShell_Class
    Set objWshShell = New IWshShell_Class

    If Right(ShortCut_PathAndName, 4) <> ".lnk" Then
        ShortCut_PathAndName = ShortCut_PathAndName & ".lnk"
    End If
   'The shortcut must end in a .lnk for a link file. If it isn't, put this entry in.
    Set objShortcut = objWshShell.CreateShortcut(ShortCut_PathAndName)
    With objShortcut
        .TargetPath = TargetApp_PathAndName
        If Right(TargetFolder, 1) = "\" Then
            .WorkingDirectory = TargetFolder
        Else
            .WorkingDirectory = TargetFolder & "\"
        End If
        .Save
    End With
    'The above creates a shortcut on the PC. This needs a reference to Microsoft Windows Script Host Object Model (Ver 1.0).
    
    Set objWshShell = Nothing
    Set objShortcut = Nothing
    'This discards the variables to free up ram and virtual memory for the program to run faster.
End Sub

Public Function StartMenu() As String
'This grabs the start menu location (hopefully regardless
'of the operating system)

    Dim WinDirectory As String, StrLength As Long
    WinDirectory = Space(255)
    StrLength = GetWindowsDirectory(WinDirectory, 255)
    WindowsDir = Left(WinDirectory, StrLength)
    'This one finds the windows folder on the PC
    
    If Len(Dir(WindowsDir & "\start menu")) = 0 Then
        StartMenu = WindowsDir & "\start menu\"
    ElseIf Len(Dir(WindowsDir & "\profiles\all users\start menu")) = 0 Then
        StartMenu = WindowsDir & "\profiles\all users\start menu\"
    ElseIf Len(Dir(WindowsDir & "\documents and settings\all users\start menu")) = 0 Then
        StartMenu = WindowsDir & "\documents and settings\all users\start menu\"
    'Else
        'Code I've not finished, this mean's the app can't find the start menu
        'unlikely, but I'm looking at registry for this - you should be alright with
        'the above on it's own.
    End If
    
End Function