Open Folder Box as Class Module (Cservers)

Title: Open Folder Box as Class Module

jarro_2783 - March 27, 2005 10:27 AM (GMT)

The microsoft common dialog control lets you open and save files, but what if you want to just open folders? Here is how.

Make a new class module and name it CFolderBrowse

then type the following code into it:

CODE

Option Explicit

'////////////////////////////////////////////
' CFolderBrowse
' a common dialog browse for folders class
' by --
'
' Properties:
'
' Prompt (string) [R|W] prompt to use
' Path (string) [Result] selected path
'
' Methods:
'
' Browse do the thing
'
' Created: --
' ////////////////////////////////////////////

Private Type SHITEMID 'shell item id structure
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST 'a list of these item identifiers
mkid As SHITEMID
End Type

Private Type BROWSEINFO 'parameters for the SHBrowseForFolder function
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

' The actual declarations. All private because this is a class.

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const DefaultPrompt = "Select a folder"

' ////////////////////////////////////////////////////////////

' / Class member variables /

' ////////////////////////////////////////////////////////////

Private ev_Path As String ' Selected Path "" means canceled
Private ev_Prompt As String ' The prompt in the dialogue

Public Property Get Path() As String
Path = ev_Path
End Property

Public Property Get Prompt() As String
Prompt = ev_Prompt
End Property

Public Property Let Prompt(Param As String)
ev_Prompt = Trim(Param)
End Property

Public Sub Browse()

Dim bi As BROWSEINFO 'browserinfo structure

Dim IDL As ITEMIDLIST 'item identifier list

Dim PointerToIdList As Long 'pointer to item identifier list

Dim Result As Long

Dim EndOfPath As Integer

Dim PathBuffer As String

bi.hOwner = 0& 'Null pointer works here

bi.pidlRoot = 0& 'say desktop folder

If ev_Prompt = "" Then ev_Prompt = DefaultPrompt 'no prompt? use default

bi.lpszTitle = ev_Prompt 'set the prompt

bi.ulFlags = BIF_RETURNONLYFSDIRS 'say only file system directories

PointerToIdList = SHBrowseForFolder(bi) 'do the actual browse

If PointerToIdList = 0& Then 'returned a Null pointer
ev_Path = "" 'means user canceled
Exit Sub 'we're all done here
End If

PathBuffer = Space(512) 'else create a buffer

'now get the selected path

Result = SHGetPathFromIDList(ByVal PointerToIdList, ByVal PathBuffer)

If Result Then 'if there is a path to get
EndOfPath = InStr(PathBuffer, vbNullChar) 'point to its end
ev_Path = Left(PathBuffer, EndOfPath - 1) 'and return just that
Else
ev_Path = "" 'otherwise say aborted
End If

End Sub

Private Sub Class_Initialize()
ev_Prompt = DefaultPrompt
End Sub

Make a new module, and put this into it:

CODE

Dim MyBrowser As New CFolderBrowse 'instantiate the class

Public Function openfolder() As String

MyBrowser.Prompt = "Select Directory"

MyBrowser.Browse

If MyBrowser.Path = "" Then
openfolder = ""
Else
openfolder = MyBrowser.Path
End If

End Function

add this code to your open button

CODE

Dim dirname As String
dirname = openfolder() 'call open folder dialogue

put this in your exit button

CODE

Unload Me
Set Form1 = Nothing

put this in your form

CODE

Private Sub Form_Unload(Cancel As Integer)
Set MyObject = Nothing ' explicitly remove the object
End Sub

then it should run. You can then put the last three sections of code into a project with any number of forms, allowing you to call it from any form, which will save a lot of code. You would use this instead of calling the open box with the same code on each form, using a tenth of the code for ten forms.

|2eM!x - March 27, 2005 06:35 PM (GMT)

nice!!
Ill enter some cool stuff ive learned here later tonight!!
Thanks for contributing Jarro

View Full Version: Open Folder Box as Class Module