Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Modifying a shortcuts properties via VB

Status
Not open for further replies.

Muzzery

Programmer
Jan 11, 2002
72
GB
Hi,

Does anyone know of a way to modify or create a windows shortcut from a line of VB code? Thanks

Muzz
 
Here's a class module you can use. Watch out for unexpected line wraps!



Option Explicit

Const CSIDL_DESKTOP = &H0
Const CSIDL_PROGRAMS = &H2
Const CSIDL_CONTROLS = &H3
Const CSIDL_PRINTERS = &H4
Const CSIDL_PERSONAL = &H5
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTUP = &H7
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_BITBUCKET = &HA
Const CSIDL_STARTMENU = &HB
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_NETWORK = &H12
Const CSIDL_NETHOOD = &H13
Const CSIDL_FONTS = &H14
Const CSIDL_TEMPLATES = &H15

Const SHARD_PATH = &H2&
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_SILENT = &H4
Const FOF_NOCONFIRMATION = &H10
Const FOF_FILESONLY = &H80
Const FOF_NOCONFIRMMKDIR = &H200

Const NOERROR As Long = 0

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function SHAddToRecentDocs Lib "shell32.dll" (ByVal dwFlags As Long, ByVal dwData As String) As Long
'local variable(s) to hold property value(s)
Private mvarShortcutName As String 'local copy
Private mvarTarget As String 'local copy
Private mvarLocation As String 'local copy
Public Sub Create()
Dim r As Long
Dim DeskTopDir As String
Dim RecentPath As String

DeskTopDir = GetSpecialFolder(CSIDL_DESKTOP)
RecentPath = GetSpecialFolder(CSIDL_RECENT)
If Not Right(RecentPath, 1) = "\" Then RecentPath = RecentPath + "\"

Create
r = SHAddToRecentDocs(SHARD_PATH, mvarTarget)

DoEvents


wkMoveFile RecentPath & mvarShortcutName & ".lnk", mvarLocation

End Sub

Public Property Let Location(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Location = 5
mvarLocation = vData
End Property


Public Property Get Location() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Location
Location = mvarLocation
End Property



Public Property Let Target(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Target = 5
mvarTarget = vData
End Property


Public Property Get Target() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Target
Target = mvarTarget
End Property



Public Property Let ShortcutName(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.ShortcutName = 5
mvarShortcutName = vData
End Property


Public Property Get ShortcutName() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ShortcutName
ShortcutName = mvarShortcutName
End Property

Private Sub wkRenameFiles(sFile As String, dFile As String)
Dim r
Dim SHFileOp As SHFILEOPSTRUCT
sFile = sFile & Chr$(0) & Chr$(0)
dFile = dFile & Chr$(0) & Chr$(0)

With SHFileOp
.wFunc = FO_RENAME
.pFrom = sFile
.pTo = dFile
.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION
End With

r = SHFileOperation(SHFileOp)

End Sub

Private Sub wkMoveFile(sFile As String, dFile As String)
Dim r
Dim SHFileOp As SHFILEOPSTRUCT
sFile = sFile & Chr(0) & Chr(0)

With SHFileOp
.wFunc = FO_MOVE
.pFrom = sFile
.pTo = dFile
.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR
End With

r = SHFileOperation(SHFileOp)
End Sub

Public Function GetSpecialFolder(CSIDL As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
Dim Path As String

r = SHGetSpecialFolderLocation(100, CSIDL, IDL)

If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialFolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If

GetSpecialFolder = ""

End Function


"The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!"
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top