This is related to my other recent post on this interface, [VB6] Code Snippet: View shortcut path w/variables unexpanded: IShellLinkDataList.
Making shortcuts to your program for Run As Administrator requires diving into the highly technical IShellLinkDataList, which is implemented by shortcut objects in addition to the IShellLink interface that is usually all you need. But shortcuts have many advanced flags and data blocks that aren't exposed by IShellLink-- look for more uses of this interface in the future.
Requirements
-Windows XP or higher
-oleexp 3.51 or newer (released with this code on 9 May 2016; 3.5 will NOT work); oleexp3.tlb must be added under Project-References, but it's an IDE-only requirement- the typelib does not need to be distributed with the compiled EXE.
The Code
It's a bit easier this time:
Making shortcuts to your program for Run As Administrator requires diving into the highly technical IShellLinkDataList, which is implemented by shortcut objects in addition to the IShellLink interface that is usually all you need. But shortcuts have many advanced flags and data blocks that aren't exposed by IShellLink-- look for more uses of this interface in the future.
Requirements
-Windows XP or higher
-oleexp 3.51 or newer (released with this code on 9 May 2016; 3.5 will NOT work); oleexp3.tlb must be added under Project-References, but it's an IDE-only requirement- the typelib does not need to be distributed with the compiled EXE.
The Code
It's a bit easier this time:
Code:
Public Sub MakeLinkElevated(sLink As String)
'sLink must include .lnk suffix (hidden even when 'show extensions' is enabled)
'e.g. C:\folder\Shortcut to MyProgram.exe.lnk
On Error GoTo e0
Dim psdi As IShellLinkDataList
Dim pLNK As ShellLinkW
Dim ppf As IPersistFile
Set pLNK = New ShellLinkW
Set ppf = pLNK
ppf.Load sLink, STGM_READWRITE
Set psdi = pLNK
Dim dwFlg As SHELL_LINK_DATA_FLAGS
psdi.GetFlags dwFlg
Debug.Print "flags=" & Hex$(dwFlg)
If (dwFlg And SLDF_RUNAS_USER) Then
Debug.Print "Already elevated."
Else
Debug.Print "Setting flag..."
dwFlg = dwFlg Or SLDF_RUNAS_USER
psdi.SetFlags dwFlg
ppf.Save sLink, 1
End If
Exit Sub
e0:
Debug.Print "MakeLinkElevated.Error->" & Err.Description
End Sub