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)
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!"
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.