VPF::Все файлы в директории - Форум программистов

Devourer

Дата 9.12.2008, 11:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 95
Регистрация: 23.8.2008

Репутация: нет
Всего: нет

Подскажите как организовать для пользователя выбор файлов из конкретной директории?
Скажем D:\Documents\.
Все организуется в Access в форме.
smile

зарание признателен.

Akina

Дата 9.12.2008, 15:12 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 30
Всего: 454

Common Dialog Control

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

bopoha

Дата 9.12.2008, 16:28 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1283
Регистрация: 10.5.2006
Где: Беларусь, Минск

Репутация: 21
Всего: 21

Вот код модуля.

Код


Option Compare Database
Option Explicit

Private Type OPENFILENAME
     lngStructSize As Long          ' Size of structure
     hwndOwner As Long              ' Owner window handle
     hInstance As Long              ' Template instance handle
     strFilter As String            ' Filter string
     strCustomFilter As String      ' Selected filter string
     intMaxCustFilter As Long       ' Len(strCustomFilter)
     intFilterIndex As Long         ' Index of filter string
     strFile As String              ' Selected filename & path
     intMaxFile As Long             ' Len(strFile)
     strFileTitle As String         ' Selected filename
     intMaxFileTitle As Long        ' Len(strFileTitle)
     strInitialDir As String        ' Directory name
     strTitle As String             ' Dialog title
     lngFlags As Long               ' Dialog flags
     intFileOffset As Integer       ' Offset of filename
     intFileExtension As Integer    ' Offset of file extension
     strDefExt As String            ' Default file extension
     lngCustData As Long            ' Custom data for hook
     lngfnHook As Long              ' LP to hook function
     strTemplateName As String      ' Dialog template name
End Type

' декларация WinAPI функий
Declare Function GetOpenFileName Lib "comdlg32.dll" _
 Alias "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" _
 Alias "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean

' Open/Save dialog flags
Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
' Flags for hook functions and dialog templates
'Global Const OFN_ENABLEHOOK = &H20
'Global Const OFN_ENABLETEMPLATE = &H40
'Global Const OFN_ENABLETEMPLATEHANDLE = &H80
' Windows 95 flags
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000

' Custom flag combinations
Global Const dhOFN_OPENEXISTING = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
Global Const dhOFN_SAVENEW = OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Global Const dhOFN_SAVENEWPATH = OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY

Private Declare Function GetActiveWindow Lib "user32" () As Long

'использовать функцию CM_FileDialog, отписание см ниже. - вызов диалогового окна на сохранение или открытие

Function CM_FileDialog( _
                Optional strInitDir As String, _
                Optional strFilter As String = _
                 "All files (*.*)" & vbNullChar & "*.*" & _
                 vbNullChar & vbNullChar, _
                Optional intFilterIndex As Integer = 1, _
                Optional strDefaultExt As String, _
                Optional strFilename As String, _
                Optional strDialogTitle As String = "Open File", _
                Optional hWnd As Long = -1, _
                Optional fOpenFile As Boolean = True, _
                Optional ByRef lngFlags As Long = _
                 dhOFN_OPENEXISTING) As Variant

    '   strInitDir (Optional)
    '       Inital directory.
    '   strFilter (Optional)
    '       File filter as null delimited/double-null
    '       terminated string.
    '   intFilterIndex (Optional, default = 1)
    '       Initial filter index.
    '   strDefaultExt (Optional)
    '       Default file extension if none specified.
    '   strFilename (Optional)
    '       Initial file name for dialog.
    '   strDialogTitle (Optional, default = "Open File")
    '       Dialog title.
    '   hwnd (Optional, default = -1)
    '       Handle of dialog owner window.
    '   fOpenFile (Optional, default = True)
    '       If True, displays Open dialog, if False,
    '       displays Save As dialog.
    '   lngFlags (Optional)
    '       Flags for API function (see declarations section).
    ' Out:
    '   lngFlags
    '       Returns flags set by the API function after closing
    '       the dialog.
    '   Return Value:
    '       Name of the file or files chosen by the user.
    ' Note:
    '       If you allow multi-select, returned string will
    '       be the directory name followed by a space-delimited
    '       list of files.
    ' Example:
    '   strFile = CM_FileDialog(strFilter:="All files" & _
    '    vbNullChar & "*.*" & vbNullChar & vbNullChar)

    Dim ofn As OPENFILENAME
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Fill in some of the missing arrguments
    If strInitDir = "" Then
        strInitDir = CurDir
    End If
    If hWnd = -1 Then
        hWnd = GetActiveWindow()
    End If

    ' Set up the return buffers
    strFilename = strFilename & String(255 - Len(strFilename), 0)
    strFileTitle = String(255, 0)

    ' Fill in the OPENFILENAME structure members
    With ofn
        .lngStructSize = Len(ofn)
        .hwndOwner = hWnd
        .strFilter = strFilter
        .intFilterIndex = intFilterIndex
        .strFile = strFilename
        .intMaxFile = Len(strFilename)
        .strFileTitle = strFileTitle
        .intMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .lngFlags = lngFlags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .intMaxCustFilter = 255
        .lngfnHook = 0
    End With

    ' Call the right function
    If fOpenFile Then
        fResult = GetOpenFileName(ofn)
    Else
        fResult = GetSaveFileName(ofn)
    End If

    ' If successful, return the filename,
    ' otherwise return Null
    If fResult Then
        ' Return any flags to the calling procedure
        lngFlags = ofn.lngFlags
        
        ' Return the result
        If (ofn.lngFlags And OFN_ALLOWMULTISELECT) = 0 Then
            CM_FileDialog = dhTrimNull(ofn.strFile)
        Else
            CM_FileDialog = ofn.strFile
        End If
    Else
        CM_FileDialog = ""
    End If
End Function



Sub dhTestDialog()
    ' Test function for CM_FileDialog function.

    ' From "VBA Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 1997; Sybex, Inc. All rights reserved.

    ' In:
    '   n/a
    ' Out:
    '   n/a
    ' Example:
    '   Call dhTestDialog()

    ' Open a file in the current directory
    Debug.Print CM_FileDialog()
    
    ' Open multiple files in the Windows directory
    Debug.Print CM_FileDialog(strInitDir:="C:\WINDOWS", _
     lngFlags:=dhOFN_OPENEXISTING Or OFN_ALLOWMULTISELECT _
     Or OFN_EXPLORER)
    
    ' Save a file as a text file
    Debug.Print CM_FileDialog(strFilter:="Text Files" & _
     vbNullChar & "*.txt" & vbNullChar & vbNullChar, _
     strDialogTitle:="Save As", lngFlags:=dhOFN_SAVENEW, _
     fOpenFile:=False)
End Sub


Function dhTrimNull(ByVal strValue As String) As String
    ' Find the first vbNullChar in a string, and return
    ' everything prior to that character. Extremely
    ' useful when combined with the Windows API function calls.
    
    ' In:
    '   strValue:
    '       Input text, possibly containing a null character
    '       (chr$(0), or vbNullChar)
    ' Out:
    '   Return Value:
    '       strValue trimmed on the right, at the location
    '       of the null character, if there was one.
    
    Dim intPos As Integer
    
    intPos = InStr(strValue, vbNullChar)
    Select Case intPos
        Case 0
            ' Not found at all, so just
            ' return the original value.
            dhTrimNull = strValue
        Case 1
            ' Found at the first position, so return
            ' an empty string.
            dhTrimNull = ""
        Case Is > 1
            ' Found in the string, so return the portion
            ' up to the null character.
            dhTrimNull = Left$(strValue, intPos - 1)
    End Select
End Function

Это сообщение отредактировал(а) bopoha - 9.12.2008, 16:55

--------------------

Как создавать приложения на MS Access

Devourer

Дата 18.12.2008, 12:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 95
Регистрация: 23.8.2008

Репутация: нет
Всего: нет

Большое спасибо!!!!
Сижу втыкаю... не все понятно.... =((((
Но всеравно СПС!

bopoha

Дата 18.12.2008, 13:14 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1283
Регистрация: 10.5.2006
Где: Беларусь, Минск

Репутация: 21
Всего: 21

см. процедуру dhTestDialog

--------------------

Как создавать приложения на MS Access

Devourer

Дата 18.12.2008, 13:21 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 95
Регистрация: 23.8.2008

Репутация: нет
Всего: нет

bopoha, Ну что запускать я понял... я не совсем еще разобрался в самом коде... ((((
Для моего уровня текущих коментов маловато ((((

Akina

Дата 18.12.2008, 21:31 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 30
Всего: 454

Devourer, я всё-таки не понимаю, чем тебя не устраивает CommonDialog.FileOpen... стандартно, достаточно функционально, и код никаких проблем не вызывает...

--------------------

Devourer

Дата 19.12.2008, 11:07 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 95
Регистрация: 23.8.2008

Репутация: нет
Всего: нет

Akina, мне ваш пример симпатичней, только я не знаю как им воспользоваться F1 молчит и F2 тоже (

Akina

Дата 19.12.2008, 12:19 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 30
Всего: 454

Нет, если не можешь найти справку по CommonDialog, тебе лучше совсем что-нить простенькое.
http://msdn.microsoft.com/en-us/library/aa...office.11).aspx

--------------------

bopoha

Дата 19.12.2008, 13:23 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1283
Регистрация: 10.5.2006
Где: Беларусь, Минск

Репутация: 21
Всего: 21

Цитата(Akina @ 19.12.2008, 12:19

)

Ха! Так это уже встроенный файловый диалог в Access. А я уже привык к той функции и нового ничего не искал. Спасибо.

--------------------

Как создавать приложения на MS Access

Akina

Дата 19.12.2008, 15:40 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 30
Всего: 454

bopoha, так разве ж я против... любая задача решается кучей способов, выбирай на вкус...

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| MS Access \| Следующая тема »