| |
Диалог выбора файла / папки
выглядит это примерно так:
Диалог выбора файла Вариант 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
| |
