Диалог выбора файла Вариант 1  
Пример кода кнопки для выбора графического файла для объекта картинка  
 
Private Sub Btn_Path_Click()  
Dim FName As String  
Dim result As Integer  
With Application.FileDialog(1)  
   .Title = "Select picture"  
   .InitialFileName = "C:\" 'default path Путь по умолчанию  
   .AllowMultiSelect = False  
   .Filters.Clear  
   .Filters.Add "Picture files", "*.bmp; *.jpg", 1  
result = .Show  
 
If result = 0 Then Exit Sub  
FName = Trim(.SelectedItems.Item(1))  
End With  
 
On error resume next  
me.imageObj.Picture = FName 'pic object Контрол формы  
End Sub  
 

Диалог выбора файла Вариант 2 ( by АлексейЕ )  

Пример выбора файла Аксесс  
 
Public Sub test_dialog2()  
Dim strFile As String, strFilter As String  
strFilter = "MS Access Database (*.mdb)|*.mdb|Add-ins (*.mda)|*.mda|MDE-Files (*.mde)|*.mde|All Files (*.*)|*.*||"  
WizHook.Key = 51488399  
WizHook.GetFileName 0, "AppName", "DlgTitle", "", strFile, "c:\", strFilter, 0, 0, 0, True  
MsgBox strFile  
End Sub  
 
 

Вариант 3 (WinApi)

 
'--- модуль api_filedialog ------------------------  
 
Option Compare Database  
Option Explicit  
'Немножко адаптированный способ кедзо  
'оригинал: http://www.sql.ru/forum/actualthread.aspx?tid=113776&hl=declare+filedialog#874185  
' Вызов диалога:  
' strFile = InputFile("Загрузка документа", "Текстовые файлы (*.txt)" & vbNullChar & "*.txt" & vbNullChar & vbNullChar , "\\server\c")  
' If strFile <> "" Then ЗАГРУЖАЙСЯ (strFile)  
 
 
Private Type OPENFILENAME  
lStructSize As Long  
hwndOwner As Long  
hInstance As Long  
lpstrFilter As String  
lpstrCustomFilter As String  
nMaxCustFilter As Long  
nFilterIndex As Long  
lpstrFile As String  
nMaxFile As Long  
lpstrFileTitle As String  
nMaxFileTitle As Long  
lpstrInitialDir As String  
lpstrTitle As String  
flags As Long  
nFileOffset As Integer  
nFileExtension As Integer  
lpstrDefExt As String  
lCustData As Long  
lpfnHook As Long  
lpTemplateName As String  
End Type  
 
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenFilename As OPENFILENAME) As Long  
 
 
'Ввод имени файла  
Public Function InputFile(ByVal strTitle As String, ByVal strFilter As String, Optional strInitialDir As String) As String  
Dim lngReturn As Long  
Dim intLocNull As Integer  
Dim strTemp As String  
Dim ofnFileInfo As OPENFILENAME  
Dim strFileName As String  
 
strFileName = String(256, 0)  
 
With ofnFileInfo  
.lStructSize = Len(ofnFileInfo)  
.lpstrFile = strFileName  
.lpstrFileTitle = String(256, 0)  
.lpstrInitialDir = strInitialDir  
.hwndOwner = Application.hWndAccessApp  
.lpstrFilter = strFilter  
.nFilterIndex = 1  
.nMaxFile = Len(strFileName)  
.nMaxFileTitle = ofnFileInfo.nMaxFile  
.lpstrTitle = strTitle  
.flags = &H1000 Or &H800  
.hInstance = 0  
.lpstrCustomFilter = String(255, 0)  
.nMaxCustFilter = 255  
.lpfnHook = 0  
End With  
 
lngReturn = GetOpenFileName(ofnFileInfo)  
If lngReturn = 0 Then  
strFileName = ""  
Else  
strTemp = Trim(ofnFileInfo.lpstrFile)  
intLocNull = InStr(strTemp, Chr(0))  
If intLocNull Then  
strTemp = Left(strTemp, intLocNull - 1)  
End If  
strFileName = strTemp  
End If  
InputFile = strFileName  
End Function  
 
'------------- Конец модуля -------------  
 
 
 
Пример вызова диалога выбора файла реализован в примере с всплывающим календарем .  
 
Примечания:  
Вариант № 1 не работает если аксесс запущен с опцией /runtime  
Вариант №2 странно ведет себя с сетевым путем если этот путь не был предварительно открыт из проводника  
 
 
 
 
 

Диалог выбора папки  
 
Dim WSHShell, folder  
On Error Resume Next  
Set WSHShell = CreateObject("Shell.application")  
Set folder = WSHShell.browseforfolder(0, "Выбор папки", 0, "C:\")  
If Not Err.Number = 91 Then MsgBox folder.Title  
Set WSHShell = Nothing  

 

Пример диалога выбора / создания папки

:
'---------------------------------------------------------------------------------------
' Procedure : fnGetFolder
' DateTime : 17.08.2006 16:12
' Author : DSonnyh
' Purpose : выбор папки
'---------------------------------------------------------------------------------------
'
Public Function fnGetFolder() As String

Dim WSHShell As Object, objFolder As Object
Dim P1, P2
'Некоторые значения констант:
' P1=0 - отображаются Рабочий стол, Мой компьютер, Сеть и "Корзина"
' P1=1 - "Корзина" не отображается
' P1=2 - "Корзина" отображается, в "Моем компьютере" выводится дополнительно "Панель Управления"
' P2 определяет верхний уровень отображения. Его можно задать как строку символов
' Пример - "C:\". Или числом. Проверено для ХР
' Р2=0 - Рабочий стол P2=10 - Корзина
' P2=1 - Интернет Explorer (недопустимо) P2=11 - Главное меню
' P2=2 - Программы Р2=12 - Рабочий стол
' P2=3 - Панель управления (недопустимо) Р2=13 - Моя музыка
' P2=4 - Принтеры и факсы (недопустимо) Р2=14 - Мои видеозаписи
' P2=5 - Мои Документы Р2=15 - Рабочий стол
' P2=6 - Избранное Р2=16 - Рабочий стол
' P2=7 - Автозагрузка Р2=17 - Мой Компьютер
' P2=8 - недавние Документы Р2=18 - Сетевой окружение
' P2=9 - SendTo Р2=19 - NetHood
' Р2=20 - Fonts Р2=21 - Templates
' Более подробную информацию об объекте можно найти в документации (EN)

On Error GoTo fnGetFolder_Error

P1 = 1
P2 = 0

Set WSHShell = CreateObject("Shell.application")
Set objFolder = WSHShell.BrowseForFolder(0, "Выбор папки", P1, P2)
fnGetFolder = objFolder.self.Path
' имя папки содержится в objFolders.Title
Set WSHShell = Nothing
Set objFolder = Nothing

On Error GoTo 0
Exit_fnGetFolder:
Exit Function

fnGetFolder_Error:

Set WSHShell = Nothing
Set objFolder = Nothing
Select Case Err.Number
Case 91
fnGetFolder = ""
Resume Exit_fnGetFolder
Case Else
MsgBox "Ошибка " & Err.Number & " (" & Err.Description & ") в процедуре fnGetFolder"
Resume Exit_fnGetFolder
End Select

End Function