Yes, that's precisely what I want to do ... but how do I populate
FullPathName with the current user's desktop?
Try using the SHGetSpecialFolder API. Put this into a module and try
it by running TestMe. Had to modify it a little as there were some
undelcared variables in it and one constant I couldn't find a value
for. Hope it still works properly.
Option Compare Database
Option Explicit
Private Declare Function SHGetSpecialFolderLocation Lib
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As
ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long
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 MAX_PATH = 260
'NOERROR
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Function GetSpecialfolder(CSIDL As Long) As String
'KPD-Team 1998
'URL:
http://www.allapi.net/
'E-Mail: (e-mail address removed)
Dim r As Long
Dim IDL As ITEMIDLIST
Dim Path1 As String
'Get the special folder
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
'Create a buffer
Path1 = Space$(512)
'Get the path from the IDList
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path1)
'Remove the unnecessary chr$(0)'s
GetSpecialfolder = Left$(Path1, InStr(Path1, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
Function TestMe()
MsgBox GetSpecialfolder(CSIDL_DESKTOP)
End Function
