Browse for folder dialog box

[Arunas]

Hi,

I can't find such a simple thing.
How to show "browse for folder" dialog box
using Access?

Thanks,
Arunas

 

[Lars-Eric Gisslén]

Arunas,

Have you tried something like this:
(Include a reference to 'Microsoft Shell Controls and Automation' in your
project)

Function SelectFolder() As String
Dim oShell As Shell32.Shell
Dim oFolder As Shell32.Folder
Dim oItems As Shell32.FolderItems
Dim Item As Shell32.FolderItem

On Error GoTo CleanUp

Set oShell = New Shell ' ActiveX interface to shell32.dll
Set oFolder = oShell.BrowseForFolder(0, "Select a folder", 0)
Set oItems = oFolder.Items
Set Item = oItems.Item

SelectFolder = Item.Path

CleanUp:
Set oShell = Nothing
Set oFolder = Nothing
Set oItems = Nothing
Set Item = Nothing

End Function

 

[Tomm]

Or simply use the API. Paste this into a module and run TestIt


Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32" (lpBrowseInfo As
BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal PIDL As
Long, ByVal lpstrBuffer As String) As Long
Private Declare Function GetActiveWindow Lib "USER32" () As Long

Private Type BROWSEINFO
hWnd As Long
lpcItemIDList As Long
lpstrDisplayName As String
lpstrTitle As String
uFlags As Long
bffCallBack As Long
lParam As Long
iImage As Integer
End Type

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Sub SelectFolder( _
ByVal istrTittel As String, _
ByRef ustrFolder As String)

Dim Folder As BROWSEINFO
Dim myPIDL As Long
Dim sBuffer As String
Dim sEmptyString As String

sEmptyString = Space(255)

Folder.hWnd = GetActiveWindow
Folder.lpstrDisplayName = sEmptyString
Folder.lpstrTitle = istrTittel
Folder.uFlags = BIF_RETURNONLYFSDIRS

myPIDL = SHBrowseForFolder(Folder)
sBuffer = sEmptyString
SHGetPathFromIDList myPIDL, sBuffer

ustrFolder = Trim(Left$(sBuffer, Len(Trim(sBuffer)) - 1))
End Sub


Sub TestIt()
Dim strFolder As String
SelectFolder "Select folder", strFolder
MsgBox strFolder
End Sub

 

[Lars-Eric Gisslén]

Tomm,

Two different interfaces to the same code. One note though, you should set
the buffer to 260 characters instead of 255. The receiving buffer is assumed
be MAX_PATH bytes long and MAX_PATH is defined to 260.

Regards,
Lars-Eric

 

[Arunas]

Thanks, this work well.

-----Original Message-----
Or simply use the API. Paste this into a module and run TestIt


Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32" (lpBrowseInfo As
BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal PIDL As
Long, ByVal lpstrBuffer As String) As Long
Private Declare Function GetActiveWindow Lib "USER32" () As Long

Private Type BROWSEINFO
hWnd As Long
lpcItemIDList As Long
lpstrDisplayName As String
lpstrTitle As String
uFlags As Long
bffCallBack As Long
lParam As Long
iImage As Integer
End Type

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Sub SelectFolder( _
ByVal istrTittel As String, _
ByRef ustrFolder As String)

Dim Folder As BROWSEINFO
Dim myPIDL As Long
Dim sBuffer As String
Dim sEmptyString As String

sEmptyString = Space(255)

Folder.hWnd = GetActiveWindow
Folder.lpstrDisplayName = sEmptyString
Folder.lpstrTitle = istrTittel
Folder.uFlags = BIF_RETURNONLYFSDIRS

myPIDL = SHBrowseForFolder(Folder)
sBuffer = sEmptyString
SHGetPathFromIDList myPIDL, sBuffer

ustrFolder = Trim(Left$(sBuffer, Len(Trim(sBuffer)) - 1))
End Sub


Sub TestIt()
Dim strFolder As String
SelectFolder "Select folder", strFolder
MsgBox strFolder
End Sub






.