Open Dialog

[Tony]

Господа день добрый! есть в Ехеле книга! а в ней страница... Так вот на ней записана своего рода конфигурация работы программы... В одной из я чеек путь до нужного файлика. Я то в ручную забивал не напрягало.... А вот проект надо шефу ставить.... беда...

Так вот есть ли какой нить способ выбора файла.... что нибудь типа диалога открытия файла... чтобы просто хоп и ок!

Надеюсь не волшебства прошу.....

[Vitaly1]

Я забыл как этот объект называется. Но он на некоторых компьютерах в дополнительных элементах есть, ставишь его на лист, и так же как в VB.

[Tony]

Не исключенно что такой элемент есть.... тока у меня там список из нескольких страниц.... Может вдруг вспомнишь как его зовут... буду примного благодарен....

[Vitaly1]

Если я не ощибась -Microsoft Comman Dialog

У него еще метод ShowOpen И ShowSave есть для открытие диалого. И свойство, какое не помню, в которое имя файла выбранного грузится!

[alibek]

Контрол называется Common Dialogs (comdlg32.ocx). Но можно обойтись и без него.
Пример из API-Guide

Код: Выделить всё

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
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 Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim OFName As OPENFILENAME
    OFName.lStructSize = Len(OFName)
    'Set the parent window
    OFName.hwndOwner = Me.hWnd
    'Set the application's instance
    OFName.hInstance = App.hInstance
    'Select a filter
    OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    'create a buffer for the file
    OFName.lpstrFile = Space$(254)
    'set the maximum length of a returned file
    OFName.nMaxFile = 255
    'Create a buffer for the file title
    OFName.lpstrFileTitle = Space$(254)
    'Set the maximum length of a returned file title
    OFName.nMaxFileTitle = 255
    'Set the initial directory
    OFName.lpstrInitialDir = "C:\"
    'Set the title
    OFName.lpstrTitle = "Open File - KPD-Team 1998"
    'No flags
    OFName.flags = 0

    'Show the 'Open File'-dialog
    If GetOpenFileName(OFName) Then
        MsgBox "File to Open: " + Trim$(OFName.lpstrFile)
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub

[Tony]

Господа огромное спасибо! РАБОТАЕТ! Остановился на втором варианте! оказался интересней! еще раз спасибо!

[Tony]

Тааак! Это все здорово! А если усложнить задачу! теперь надо выбрать не файл.... а директорию... пробовал пользоваться этим... но пока конкретный файл не дернеш.... никак...

[corgi]

добавляем модуль и в него

Код: Выделить всё

Public Declare Function SHGetSpecialFolderLocation Lib "Shell32.DLL" (ByVal hwndOwner As Long, ByVal Folder As Long, ByRef idl As Long) As Long ' Shell types
Public Declare Function SHBrowseForFolder Lib "Shell32.DLL" (ByRef bi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "Shell32.DLL" (ByVal idl As Long, ByVal Path As String) As Integer
Public Const dhcMaxPath = 260
Public Const dhcNoError = 0&
Public Const dhcErrorExtendedError = 1208&
Public Const MAX_PATH = 260

Public Type BrowseInfo
    hwndOwner As Long
    pidlRoot As Long
    strDisplayName As String
    strTitle As String '
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Function dhBrowseForFolder( _
ByVal lngCSIDL As Long, ByVal lngBifFlags As Long, strFolder As String, _
Optional ByVal hWnd As Long = 0, _
Optional strTitle As String = "Select Directory") As Long


Dim usrBrws As BrowseInfo
Dim lngReturn As Long
Dim lngIDL As Long

If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then

    With usrBrws
        .hwndOwner = hWnd
        .pidlRoot = lngIDL
        .strDisplayName = Strings.String$(dhcMaxPath, vbNullChar)
        .strTitle = strTitle
        .ulFlags = lngBifFlags
    End With

    lngIDL = SHBrowseForFolder(usrBrws)

    If lngIDL Then
        strFolder = Strings.String$(dhcMaxPath, vbNullChar)

        If SHGetPathFromIDList(lngIDL, strFolder) Then
            strFolder = dhTrimNull(strFolder)
            lngReturn = dhcNoError
        Else
            strFolder = dhTrimNull(usrBrws.strDisplayName)
            lngReturn = dhcNoError
        End If

        Else
            lngReturn = dhcErrorExtendedError
    End If

Else
    lngReturn = dhcErrorExtendedError
End If

dhBrowseForFolder = lngReturn
End Function


Private Function dhTrimNull(ByVal strValue As String) As String
Dim intPos As Integer

intPos = Strings.InStr(strValue, vbNullChar)
Select Case intPos
    Case 0
        dhTrimNull = strValue
    Case 1
        dhTrimNull = ""
    Case Is > 1
        dhTrimNull = Strings.Left$(strValue, intPos - 1)
End Select
End Function


а пользоватся так:

Код: Выделить всё

Dim a As Long, strFolder As String
    a = dhBrowseForFolder(a, a, strFolder, 0, "Укажите каталог")
    If a = 0 Then
        Path = strFolder
    End If


[Tony]

СУПЕРРРР!!!! Господа! все отлично! Огромнейшее спасибо! Будете в Екатеринбурге пиво за мной!