'' BIF_Options
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_BROWSEINCLUDEURLS = &H80
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_EDITBOX = &H10
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_SHAREABLE = &H8000
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_USENEWUI = &H40
Public Const BIF_VALIDATE = &H20
Public Const BIF_NONEWFOLDERBUTTON = &H200
'//
'// CSIDL values provide a unique system-independent way to identify special folders
'// used frequently by applications, but which may not have the same name or location
'// on any given system. For example, the system folder may be
'// "C:\Windows\System" on one system and "C:\Winnt\System32" on another, typically Work :-)
'// Tip:
'// Enum the CSIDL constants for easier data changing
'// Make sure Auto List Member is Ticked —
'// Displays a list that contains information that would logically complete the statement
'// at the current insertion point.
'// eg Typing in SpecFolders gives you all the Constants below
'// Here is The List I was able to gather = 53
'// Some of which may NOT be avail for your OS
'// Make it Public so it is avail to All your Modules
'//
Public Enum SpecFolders
CSIDL_APPDATA = &H1A
CSIDL_BITBUCKET = &HA
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_COMMON_DOCUMENTS = &H2E
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_COMMON_PROGRAMS = &H17
CSIDL_COMMON_STARTMENU = &H16
CSIDL_COMMON_STARTUP = &H18
CSIDL_COMMON_TEMPLATES = &H2D
CSIDL_COMMONALTSTARTUP = &H1E
CSIDL_COMMONAPPDATA = &H23
CSIDL_COMMONDESKTOP = &H0
CSIDL_COMMONMYMUSIC = &H35
CSIDL_COMMONMYPICTURES = &H36
CSIDL_COMMONMYVIDEOS = &H37
CSIDL_COMMONSTARTADMIN = &H2F
CSIDL_CONNECTIONS = &H31
CSIDL_CONTROLS = &H3
CSIDL_DRIVES = &H11
CSIDL_FAVORITES = &H6
CSIDL_FONTS = &H14
CSIDL_LOCALALTSTARTUP = &H1D
CSIDL_LOCALAPPDATA = &H1C
CSIDL_LOCALAPPMSCDBURNING = &H3B
CSIDL_LOCALCOOKIES = &H21
CSIDL_LOCALDESKTOPDIRECTORY = &H10
CSIDL_LOCALHISTORY = &H22
CSIDL_LOCALINTERNETCACHE = &H20
CSIDL_LOCALMYVIDEOS = &HE
CSIDL_LOCALSTARTADMIN = &H30
CSIDL_MSHOME = &H3D
CSIDL_MYMUSIC = &HD
CSIDL_MYPICTURES = &H27
CSIDL_NETHOOD = &H13
CSIDL_NETWORK = &H12
CSIDL_PERSONAL = &H5
CSIDL_PRINTERS = &H4
CSIDL_PRINTHOOD = &H1B
CSIDL_PROFILE = &H28
CSIDL_PROGRAM_FILES = &H26
CSIDL_PROGRAM_FILES_COMMON = &H2B
CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
CSIDL_PROGRAM_FILESX86 = &H2A
CSIDL_PROGRAMS = &H2
CSIDL_RECENT = &H8
CSIDL_RESOURCES = &H39
CSIDL_SENDTO = &H9
CSIDL_STARTMENU = &HB
CSIDL_STARTUP = &H7
CSIDL_SYSTEM = &H25
CSIDL_SYSTEMX86 = &H29
CSIDL_TEMPLATES = &H15
CSIDL_WINDOWS = &H24
End Enum
'// Minimum DLL version shell32.dll version 4.71 or later
'// Minimum operating systems Windows 2000, Windows NT 4.0 with Internet Explorer 4.0,
'// Windows 98, Windows 95 with Internet Explorer 4.0
'// objFolder = objShell.BrowseForFolder(Hwnd, sTitle, BIF_Options [, vRootFolder])
Public Function BrowseForFolderShell( _
Optional Hwnd As Long = 0, _
Optional sTitle As String = "", _
Optional BIF_Options As Integer = BIF_VALIDATE, _
Optional vRootFolder As Variant) As String
Dim objShell As Object
Dim objFolder As Variant
Dim strFolderFullPath As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(Hwnd, sTitle, BIF_Options, vRootFolder)
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.path) Then strFolderFullPath = CStr(objFolder): GoTo GotIt
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.path) > 3 Then
strFolderFullPath = objFolder.Items.Item.path & Application.PathSeparator
Else
strFolderFullPath = objFolder.Items.Item.path
End If
Else
'// User cancelled
GoTo XitProperly
End If
GotIt:
BrowseForFolderShell = strFolderFullPath
XitProperly:
Set objFolder = Nothing
Set objShell = Nothing
End Function
Sub TesterI()
'// STD test
Dim strFolder As String
strFolder = BrowseForFolderShell(, , , 0)
If strFolder = vbNullString Then
MsgBox "You cancelled"
Else
MsgBox strFolder
End If
End Sub
Sub TesterII()
'// Using Special Folders
'// This will not only limit the User to a specific Folder
'// BUT give the proper LOCATION to these special Folders!
Dim strFolder As String
strFolder = BrowseForFolderShell(, , , SpecFolders.CSIDL_PROGRAMS)
If strFolder = vbNullString Then
MsgBox "You cancelled"
Else
MsgBox strFolder
End If
End Sub
Sub BrowseFavorites()
'// Using String
'// This will not only limit the User to a specific Folder
Dim strFolder As String
Dim objShell As Object
Dim objFolder As Variant
Dim strFolderFullPath As String
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
'Set objFolder = objShell.Namespace(&H6)
Set objFolder = objShell.BrowseForFolder(0, "", BIF_BROWSEINCLUDEFILES, &H6)
On Error GoTo 0
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.path) Then strFolderFullPath = CStr(objFolder): GoTo GotIt
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.path) > 3 Then
strFolderFullPath = objFolder.Items.Item.path & Application.PathSeparator
Else
strFolderFullPath = objFolder.Items.Item.path
End If
Else
'// User cancelled
GoTo XitProperly
End If
GotIt:
'strFolderFullPath
XitProperly:
Set objFolder = Nothing
Set objShell = Nothing
If strFolderFullPath = vbNullString Then
MsgBox "You cancelled"
Else
MsgBox strFolder
End If
End Sub
Private Sub btnGetDetailsOf_Click()
Dim objShell As Shell
Dim objFolder As Folder
Set objShell = New Shell
Set objFolder = objShell.Namespace("C:\WINDOWS")
If (Not objFolder Is Nothing) Then
Dim objFolderItem As FolderItem
Set objFolderItem = objFolder.ParseName("clock.avi")
If (Not objFolderItem Is Nothing) Then
Dim szItem As String
szItem = objFolder.GetDetailsOf(objFolderItem, 2)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub