P.T.A.M. Administrator

Joined: 08 Oct 2003 Posts: 752 Location: Greece
|
Posted: Oct 10th, 2003 08:06 AM Post subject: Directories that vary between windows versions |
|
|
This will get you the directory of some commonly used folders. Add a command button (Command1) to your form :
| Code: | Option Explicit
Private Const CSIDL_DESKTOP = &H0 '{desktop}
Private Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Private Const CSIDL_PROGRAMS = &H2 'Start MenuPrograms
Private Const CSIDL_CONTROLS = &H3 'My ComputerControl Panel
Private Const CSIDL_PRINTERS = &H4 'My ComputerPrinters
Private Const CSIDL_PERSONAL = &H5 'My Documents
Private Const CSIDL_FAVORITES = &H6 '{user}Favorites
Private Const CSIDL_STARTUP = &H7 'Start MenuProgramsStartup
Private Const CSIDL_RECENT = &H8 '{user}Recent
Private Const CSIDL_SENDTO = &H9 '{user}SendTo
Private Const CSIDL_BITBUCKET = &HA '{desktop}Recycle Bin
Private Const CSIDL_STARTMENU = &HB '{user}Start Menu
Private Const CSIDL_DESKTOPDIRECTORY = &H10 '{user}Desktop
Private Const ERROR_SUCCESS = 0&
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 Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Function GetSpecialFolder(hwnd As Long, CSIDL As Long) As String
Dim pidl As Long
Dim Pos As Long
Dim sPath As String
'fill the pidl with the specified folder item
If SHGetSpecialFolderLocation(hwnd, CSIDL, pidl) = ERROR_SUCCESS Then
'initialize & get the path
sPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
'check for a null
Pos = InStr(sPath, Chr$(0))
If Pos Then 'strip it
GetSpecialFolder = Left$(sPath, Pos - 1)
End If
Call CoTaskMemFree(pidl)
End If
End If
End Function
Private Sub Command1_Click()
Dim strStartUpFolder As String
strStartUpFolder = GetSpecialFolder(Me.hwnd, CSIDL_STARTUP)
Label1.Caption = strStartUpFolder
End Sub |
_________________ No one is completely useless. They can at least be an example of what to avoid. |
|