pidlRoot это корень для определенных папок, а не для произвольного.

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

Private mvarInitDir As String

Private Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Private Enum eBrowseFlag
    BIF_RETURNONLYFSDIRS = &H1      ' For finding a folder to start document searching
    BIF_DONTGOBELOWDOMAIN = &H2     ' For starting the Find Computer
    BIF_STATUSTEXT = &H4
    BIF_RETURNFSANCESTORS = &H8
    BIF_EDITBOX = &H10
    BIF_VALIDATE = &H20             ' insist on valid result (or CANCEL)
   
    BIF_BROWSEFORCOMPUTER = &H1000  'Browsing for Computers.
    BIF_BROWSEFORPRINTER = &H2000   'Browsing for Printers
    BIF_BROWSEINCLUDEFILES = &H4000 'Browsing for Everything
   
End Enum

Private Enum eRootDirectory
    DESKTOP = &H0
    INTERNET = &H1
    PROGRAMS = &H2
    Controls = &H3
    Printers = &H4
    PERSONAL = &H5
    FAVORITES = &H6
    STARTUP = &H7
    RECENT = &H8
    SENDTO = &H9
    BITBUCKET = &HA
    STARTMENU = &HB
    DESKTOPDIRECTORY = &H10
    DRIVES = &H11
    NETWORK = &H12
    NETHOOD = &H13
    Fonts = &H14
    TEMPLATES = &H15
    COMMON_STARTMENU = &H16
    COMMON_PROGRAMS = &H17
    COMMON_STARTUP = &H18
    COMMON_DESKTOPDIRECTORY = &H19
    APPDATA = &H1A
    PRINTHOOD = &H1B
    ALTSTARTUP = &H1D                          ' DBCS
    COMMON_ALTSTARTUP = &H1E                   ' DBCS
    COMMON_FAVORITES = &H1F
    INTERNET_CACHE = &H20
    COOKIES = &H21
    HISTORY = &H22
End Enum

Const MAX_PATH = 260

' message from browser
Const BFFM_INITIALIZED = 1
Const BFFM_SELCHANGED = 2
Const BFFM_VALIDATEFAILEDA = 3      'lParam:szPath ret:1(cont),0(EndDialog)

' messages to browser
Const WM_USER = &H400
Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Const BFFM_ENABLEOK = (WM_USER + 101)
Const BFFM_SETSELECTIONA = (WM_USER + 102)
Const BFFM_SETSELECTIONW = (WM_USER + 103)
Const BFFM_SETSTATUSTEXTW = (WM_USER + 104)

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'call dialog box "Browse for Folder"
'Parameter: hwndOwner       - [in] handle of owner window (0 - modales mode, other - modal mode)
'           sPrompt         - [in] user defined string
'           RootDirectory   - [in] root directory from which to start browsing
'           InitDir         - [in] initialization directory
'           Flags           - [in] Flags specifying the options for the dialog box
'           Path            - [out] Selected path (full path of folder or file)
'           DisplayName     - [out] Selected display name
'Return:    True            - user chooses the OK button in the dialog box
'           False           - User chooses the Cancel button in the dialog box
Public Function BrowseForFolderEx(ByVal hwndOwner As Long, _
                                    ByVal sPrompt As String, _
                                    ByVal RootDirectory As Long, _
                                    ByVal InitDir As String, _
                                    ByVal Flags As Long, _
                                    ByRef Path As String, _
                                   

Ответить

Спасибо за развернутый ответ boevik, однако это не то что требуется...

В который раз перечитывая MSDN наткнулся: 

Реализация метода BrowseForFolder обекта Shell (ссылка на shell32.dll естественно)

Private Sub fnShellBrowseForFolderVB()    Dim objShell   As Shell    Dim ssfWINDOWS As Long    Dim objFolder  As Folder        ssfWINDOWS = 36    Set objShell = New Shell        Set objFolder = objShell.BrowseForFolder(0, "Example", 0, ssfWINDOWS)            If (Not objFolder Is Nothing) Then                'Add code here            End If        Set objFolder = Nothing    Set objShell = NothingEnd Sub

Однако вот досада, здесь отсутствует возможность инициализации начальной папки. 

Существует также интерфейс IShellFolder с методом ParseDisplayName возращающим PIDL. 

В том же MSDN сказано по поводу типа BROSWEINFO:

(pidlRoot - Pointer to an item identifier list (PIDL) specifying the location of the root folder from which to start browsing. Only the specified folder and any subfolders that are beneath it in the namespace hierarchy will appear in the dialog box. This member can be NULL; in that case, the namespace root (the desktop folder) is used)

Но как вызвать этот интерфейс? Он вроде интерфес COM обекта, а Shell, как подозреваю и есть реализация этого объекта.

Мдя, совсем запутался... 

Видит ли кто-нибудь выход, чтоб и корень с любой папки, и инициализая была ?

Ответить

Не уверен, что понял вопрос, но выскажусь. Как я понял, нужно найти определенный каталог в произвольном каталоге. Как сырой вариант, могу предложить процедуру DirWalk для поиска типа файлов в поддереве каталогов. Адаптировать ее будет несложно.

ВЫБРАТЬ ВСЕ ФАЙЛЫ ПО МАСКЕ В ПОДДЕРЕВЕ КАТАЛОГОВ

VB3, VB4 16/32, VB5

Level: Intermediate

Поскольку этот код не использует API, Вы можете легко перенести его с 16- на 32-разрядную платформу и обратно. Процедура DirWalk позводит Вам просмотреть все поддерево, начиная с заданнного места:

ReDim sArray(0) As String

Call DirWalk("OLE*.DLL", "C:\", sArray)

Эта процедура принимает * и ? в первом аргументе, который задает маску поиска. Вы можете задать несколько масок, разделяя их символом ";", например, "OLE*.DLL; *.TLB". Второй аргумент - место старта, третий аргумент - массив строк.

Эта процедура рекурсивно проходит по всем каталогам и кладет все файлы, удовлетворяющие условию, в массив sArray с указанием полного пути. Этот массив меняет свои размеры в зависимости от количества файлов, удовлетворяющих условиям поиска.

Для использовния DirWalk, пихните два контрола, FileListBox и DirListBox, на форму. Эта процедура подразумевает, что она работает с контролами на текущей форме: : FileListBox по имени File1, и DirListBox по имени Dir1. Для увеличения скорости работы сделайте эти контролы невидимыми. Использование этих контролов не требует приобретения дополнительных тулзов, так как они (контролы) содержатся в базовой библиотеке контролов VB.

Sub DirWalk(ByVal sPattern As String, _

ByVal CurrDir As String, sFound() _

As String)

Dim i As Integer

Dim sCurrPath As String

Dim sFile As String

Dim ii As Integer

Dim iFiles As Integer

Dim iLen As Integer

If Right$(CurrDir, 1) <> "\" Then

Dir1.Path = CurrDir & "\"

Else

Dir1.Path = CurrDir

End If

For i = 0 To Dir1.ListCount

If Dir1.List(i) <> "" Then

DoEvents

Call DirWalk(sPattern, _

Dir1.List(i), sFound())

Else

If Right$(Dir1.Path, 1) = "\" _

Then

sCurrPath = Left(Dir1.Path, _

Len(Dir1.Path) - 1)

Else

sCurrPath = Dir1.Path

End If

File1.Path = sCurrPath

File1.Pattern = sPattern

If File1.ListCount > 0 Then

' нужные файлы найдены в каталоге

For ii = 0 To File1._

ListCount - 1

ReDim Preserve _

sFound(UBound(sFound) _

+ 1)

sFound(UBound(sFound) - _

1) = sCurrPath & _

"\" & File1.List(ii)

Next ii

End If

iLen = Len(Dir1.Path)

Do While Mid(Dir1.Path, iLen, _

1) <> "\"

iLen = iLen - 1

Loop

Dir1.Path = Mid(Dir1.Path, 1, _

iLen)

End If

Next i

End Sub

Вот и все. Извини, если не понял вопроса...

Ответить

Прошу прощения за глюк с переносом строк.

Подобная рекурсивная процедура удобна для формирования списков файлов и папок.

Мне же необходим выбор каталога юзером. Причем хотелось бы не изобретать велосипед,

а пользоваться встроенными средствами.

В MSDN есть примеры получения интерфейса IShellFolder и работы с ним совместно с

API функциями на С++, получая через его методы указатель на любую папку, а вот под

VB или VBA подобные действия вызывают у меня затруднения. Зато там есть возможность

использовать СОМ объект Shell, позволяющий почти все то же самое, почти... И без

возможности работы с API (я не нашел). В частности отсутствует возможность

инициализация начальной папки в диалоге выбора каталога, как в примере выше.

пример:

ссылка на shell.dll

Private Sub fnShellBrowseForFolderVB()

Dim objShell As Shell

Dim stRootPath As String

Dim objFolder As Folder

stRootPath = "C:\BOX" 'если есть конечно.

Set objShell = New Shell

Set objFolder = objShell.BrowseForFolder(0, "Example", 0, stRootPath)

If (Not objFolder Is Nothing) Then

'Add code here

End If

Set objFolder = Nothing

Set objShell = Nothing

End Sub

Повторюсь, хочется открыть диалог выбора каталога с пользовательской папкой в

качестве корня и внутренним подкаталогом в качестве начальной папки под VB и VBA.

По отдельности это вполне возможно, а вместе ?

И можно ли в VB и VBA обратиться к интерфейсу IShellFolder напрямую ?

(если я конечно в ту сторону копаю)

Ответить

Господа, чего ж вы творите, смотреть страшно . Еще что-нибудь подобное узрею, удалю...

Ставьте  br> хотя бы

Ответить