Or, if you really want the API version:
Private Declare Function SHGetSpecialFolderLocation
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Private Sub Form_Load()
sPathToDesktop = GetSpecialFolder(Me.hWnd, CSIDL_DESKTOPDIRECTORY)
End Sub
Private Function GetSpecialFolder(hWnd As Long, CSIDL As Long) As String
Dim pidl As Long
Dim sPath As String
'fill the pidl with the specified folder item
If SHGetSpecialFolderLocation
'initialize & get the path
sPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
'return folder
GetSpecialFolder = TrimNull(sPath)
End If
End If
Call CoTaskMemFree(pidl)
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr))
End Function
(http://vbnet.mvps.org/ind
Main Topics
Browse All Topics
by: bingiePosted on 2006-09-23 at 19:21:46ID: 17585333
Private Function getPathToDesktop() As String
'Wrapper based on http:Q_20723487.html
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shel
If (Not WSHShell Is Nothing) Then
getPathToDesktop = WSHShell.SpecialFolders("D
End If
Set WSHShell = Nothing
End Function