Разработка баз данныхРазработка баз данных

 Программирование  Программы  Ссылки  Обратная связь
     
. . .
. . .
startpage.htm Новости
about.htm О сайте
fileformat.htm I. Выбор технологии
clientserver.htm Преимущества клиент-серверной технологи
prepare.htm Переход от MDB к ADP
upsizing.htm Инструменты переноса данных
setupserver.htm Выбор версии и установка сервера
selectclient.htm Выбор версии MSAccess
formsreports.htm II. Формы, Отчеты MSAccess
queries.htm Запросы / ADO
inputparameters.htm Передача входных параметров
data_drivers.htm Библиотеки доступа к данным
forms.htm Формы MSAccess
requery.htm Обновление данных в форме
updatableform.htm Обновляемость данных в форме
dialogform.htm Остановка кода пока открыта форма
formsaverecord.htm Сохранить текущую запись
formgotorecord.htm Переход по записям формы
sumform.htm Итоги в формах
serverfiltersample.htm Пример серверного фильтра
formerror.htm Причина Ошибки #Error
menubarevent.htm Перехват нажатия на кнопку меню
woconditionalformat.htm Раскраска строк ленточной формы без условного форматирования
currrec.htm Выделение цветом текущей записи
subform.htm Подчиненные Формы
textboxenter.htm Ввод перевода строки
twimagelistbug.htm treview + imagelist + подч. форма
reports.htm Отчеты, общие рекомендации
report_input_parameters.htm Входные параметры
vbaprog.htm III. Программирование VBA
dbpic.htm Картинки в базе данных
binbmp.htm Двоичные данные картинки в поле таблицы базы данных
piclink.htm Хранение ссылок на файлы
picjpg.htm Бинарное содержимое JPG, Gif файла в бинарном поле базы данных
playsound.htm Воспроизведение звуков
tv.htm Функции для тривью
restartaccess.htm Перезапуск Аксесса
publicvariables.htm Передача и хранение параметров и настроек
collectionfunctions.htm Коллекция полезных функций
datepicker.htm Всплывающий календарик
menuhummer.htm Меню и тулбары
padeg.htm Склонение по падежам
comborowsource.htm Источник данных для поля со списком
filedialog.htm Диалог выбора файла / папки
sendmapi.htm Отправка почты (4 способа) + архивация
autoupdateclient.htm Автоматическое обновление клиентской части
licenses.htm  Устранение проблем с регистрацией компонентов
uncommented.htm Без коментариев
filetime.htm Время и дата файла
reportsample.htm Пример настраивомого отчета
adpformfilter.htm Серверный Фильтр by GEO
tempmdb.htm ADP: Временный MDB для временных таблиц
mutex.htm Запрет запуска нескольких копий приложения
translit.htm Транслитерация всего проекта.
updateident.htm Изменение счетчика
webinterface.htm IV WEB
accessinternet.htm Работа с аксесс через интернет
webupdate.htm Обновление приложения аксесс через интернет
msiecom.htm Программное управление веббраузером
sqlserver.htm MS SQL
mssqltransfer2.htm Перенос/копирование баз
mssqlperm.htm Adp проверка прав пользователя перед открытием формы или управление доступностью полей формы
mssqlcrossdatabase.htm  Межбазовые разрешения
tsqlcollection.htm T-sql коллекция
similarity.htm Сортировка по созвучности
esp.htm расширенные хранимые процедуры
mssqloptimizing.htm Оптимизация быстродействия
    

Диалог выбора файла / папки

 
выглядит это примерно так:  
filedialog  
 

Диалог выбора файла Вариант 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
 
. . .
. . .
© 2000 - 2009 Алексей Козин эта вебстраница является зеркалом сайта www.msdatabase.ru

Free web hostingWeb hosting
Рейтинг@Mail.ru