Обзор папок, вспомнить прежную открытую папку

[FelixMacintosh]

Сейчас делаю отдельный компонент который бы при нажатии кнопки
показывал папки в отдельном окне

часть информации собрал на англо-язычных сайтах

там в архиве некоторые коментарии переведены
и читаются ужасно, но понять можно

сам то я вот что хочу выяснить
куда записать значение пути чтоб при повторном вызове окна обзора

эта папка была уже открыта, а корневая папка так-же оставалась бы
рабочим столом
ниже текст + архив прилагаю:

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

Option Explicit
'При нажатии на кнопку вы получите доступ ко всем папкам и файлам
'компьютера. Вы можете ограничить возможность выбирать только папки.
'Наличие BIF-констант в вызываемой функции и определяет такие возможности
'по выбору.

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

Private Enum WhatBrowse
    BIF_RETURNONLYFSDIRS = 1 'Только вернуться каталоги файловой системы.  Если пользователь выбирает папки, которые не являются частью файловой системы, кнопка ОК будет недоступна. // Примечание Кнопка ОК остается включенным для "\ \ сервер" предметов, а также "\ \ сервер \ акцию" и предметов каталога.  Однако, если пользователь выбирает пункт "\ \ сервер", попутный PIDL возвращаемый SHBrowseForFolder , чтобы SHGetPathFromIDList не удается.
    BIF_DONTGOBELOWDOMAIN = 2 'Не включайте сетевые папки ниже уровня домена в управления иерархического диалогового окна.
    BIF_STATUSTEXT = 4 'Включите область состояния в диалоговом окне.  Функция обратного вызова можно установить текст состояния, посылая сообщения в диалоговое окно.  Этот флаг не поддерживается, если BIF_NEWDIALOGSTYLE указан.
    BIF_RETURNFSANCESTORS = 8 'Только вернуться файловой системы предков.  Предком является вложенной, что это под корневой папке в иерархии пространства имен.  Если пользователь выбирает предка корневой папке, что не является частью файловой системы, кнопка ОК будет недоступна.
    BIF_EDITBOX = 16 'Включите элемент управления редактирования в диалоговом окне просмотра, что позволяет пользователю ввести имя элемента.
    BIF_VALIDATE = 32 'Если пользователь недопустимое имя в поле редактирования, диалоговое окно просмотра называет приложения BrowseCallbackProc с сообщением BFFM_VALIDATEFAILED.  Этот флаг игнорируется, если BIF_EDITBOX не уточняется.
    BIF_NEWDIALOGSTYLE = 64 'Используйте новый пользовательский интерфейс.  Установка этого флага предоставляет пользователю с большим диалоговом окне может быть изменен.  Диалоговое окно имеет несколько новых возможностей, в том числе: возможность перетащить и падение в диалоговом окне, изменения порядка, контекстных меню, новые папки, удалять и других команд контекстного меню. // Примечание Если COM инициализируется через CoInitializeEx с COINIT_MULTITHREADED установленным флагом, SHBrowseForFolder терпит неудачу, если BIF_NEWDIALOGSTYLE передается.
    BIF_USENEWUI = 80 'Используйте новый пользовательский интерфейс, в том числе в поле ввода.  Этот флаг эквивалентен BIF_EDITBOX | BIF_NEWDIALOGSTYLE. // Примечание Если COM инициализируется через CoInitializeEx с COINIT_MULTITHREADED установленным флагом, SHBrowseForFolder терпит неудачу, если BIF_USENEWUI передается.
    BIF_BROWSEINCLUDEURLS = 128 'Диалоговое окно просмотра может отображать URL.  Флаги BIF_USENEWUI и BIF_BROWSEINCLUDEFILES также должен быть установлен.  Если любой из этих трех флагов не установлен, то в диалоговом окне Браузер отвергает URL.  Даже когда эти флаги установлены, диалоговое окно обзора отображает URL-адреса, только если папка, которая содержит выбранный элемент поддерживает URL.  Когда папка в IShellFolder :: GetAttributesOf метод называется запросить атрибуты выбранного элемента, папка должна установить флаг атрибута SFGAO_FOLDER.  В противном случае, диалоговое окно просмотра не будет отображать URL.
    BIF_UAHINT = 256 'В сочетании с BIF_NEWDIALOGSTYLE, добавляет намек использования в диалоговое окно, вместо окне редактирования.  BIF_EDITBOX отменяет этот флаг.
    BIF_NONEWFOLDERBUTTON = 512 'Не включайте кнопку New Folder в диалоговом окне просмотра
    BIF_NOTRANSLATETARGETS = 1024 'Если выбранный элемент является сокращением, вернуть PIDL самого ярлыка, а не его цель.
    BIF_BROWSEFORCOMPUTER = 2048 'Только вернуть компьютеры.  Если пользователь выбирает ничего, кроме компьютера, кнопка ОК будет недоступна.
    BIF_BROWSEFORPRINTER = 4096 'Только позвольте выбор принтеров.  Если пользователь выбирает ничего, кроме принтера, кнопка ОК будет недоступна.
    BIF_BROWSEINCLUDEFILES = 8192 'Диалоговое окно просмотра отображает файлы, а также папки.
    BIF_SHAREABLE = 16384 'Диалоговое окно просмотра может отображать совместно используемых ресурсов на удаленных системах.  Это предназначено для приложений, которые хотят выставить удаленных акций на локальной системе.  Флаг BIF_NEWDIALOGSTYLE также должен быть установлен.
    BIF_BROWSEFILEJUNCTIONS = 32768 'Windows 7 и выше.  Разрешить папки переходов, таких как библиотеки или сжатый файл с расширением. Имя архива, чтобы можно просматривать.
End Enum

Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
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

Public Function fBrowseForFolder(hWndOwner As Long, sPrompt As String, WhatBr) As String
    Dim iNull As Integer
    Dim lpIDList As Long
    Dim lResult As Long
    Dim sPath As String
    Dim udtBI As BrowseInfo

    With udtBI
        .hWndOwner = hWndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = WhatBr
    End With
    lpIDList = SHBrowseForFolder(udtBI)

    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
    End If

    fBrowseForFolder = sPath
End Function

Private Sub Command1_Click()
    Dim sStr As String
    'вместо входящего параметра BIF_BROWSEINCLUDEFILES вы можете использовать одну из
    'BIF-констант, описанных строчкой Private Enum WhatBrowse (смотри в разделе General_Declarations)
    sStr = fBrowseForFolder(hWnd, "Выберите папку, файл, принтер или компьютер", 1 + BIF_EDITBOX)
    Text1.Text = sStr
End Sub


[FelixMacintosh]

Я уже нашел ответ, сообщение было одобренно спустя около 6 часов после написания

автор ответа The Trick

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

Option Explicit

Private Const MAX_PATH = 1024       ' Maximum long filename path length

Private msStartPath As String

Public Const BFFM_INITIALIZED As Long = 1
Public Const WM_USER As Long = &H400
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)

Public Const CSIDL_DESKTOP = &H0    'DeskTop
Public Const CSIDL_PROGRAMS = &H2   'Program Groups Folder
Public Const CSIDL_CONTROLS = &H3   'Control Panel Icons Folder
Public Const CSIDL_PRINTERS = &H4   'Printers Folder
Public Const CSIDL_PERSONAL = &H5   'Documents Folder
Public Const CSIDL_FAVORITES = &H6  'Favorites Folder
Public Const CSIDL_STARTUP = &H7    'Startup Folder
Public Const CSIDL_RECENT = &H8     'Recent folder
Public Const CSIDL_SENDTO = &H9     'SendTo Folder
Public Const CSIDL_BITBUCKET = &HA  'Recycle Bin Folder
Public Const CSIDL_STARTMENU = &HB  'Start Menu Folder
Public Const CSIDL_DESKTOPDIRECTORY = &H10  'Windows\Desktop Folder
Public Const CSIDL_DRIVES = &H11    'Devices Virtual Folder (My Computer)
Public Const CSIDL_NETWORK = &H12   'Network Neighborhood Virtual Folder
Public Const CSIDL_NETHOOD = &H13   'Network Neighborhood Folder
Public Const CSIDL_FONTS = &H14     'Fonts Folder
Public Const CSIDL_TEMPLATES = &H15 'ShellNew folder
Public Const BIF_RETURNONLYFSDIRS = &H1&    'Show only File System Folders

Private Type SHItemID
     cb      As Long    'Size of the ID (including cb itself)
     abID    As Byte    'The item ID (variable length)
End Type

Private Type ItemIDList
     mkid    As SHItemID
End Type

Private Type BROWSEINFO
     hOwner          As Long
     pidlRoot        As Long
     pszDisplayName  As String
     lpszTitle       As String
     ulFlags         As Long
     lpCallbackProc  As Long
     lParam          As Long
     iImage          As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Retrieves the location of a special (system) folder.
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ItemIDList) As Long
'ParseDisplayName function should be used instead of this undocumented function.
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessagePidl Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim sPath As String
     Select Case uMsg
         Case BFFM_INITIALIZED
             If lpData = 0 And Len(msStartPath) > 0 Then
                 ' Set the dialog's pre-selected folder using the stored path.
                 sPath = msStartPath
                 If Right$(sPath, 1) = "\" Then
                     sPath = Left$(sPath, Len(sPath) - 1)
                 End If
                 sPath = sPath & vbNullChar
                 Call SendMessage(hWnd, BFFM_SETSELECTIONA, 1, sPath)
             Else
                 ' Set the dialog's pre-selected folder using the pidl
                 ' set in bi.lParam and passed in the lpData param.
                 Call SendMessagePidl(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
             End If
     End Select
End Function

Public Function BrowseForFolder(hOwnerWnd As Long, Optional ByVal sInstruct As String, Optional vSelPath As Variant, Optional vTopFolder As Variant, Optional ByVal bFileSystemOnly As Boolean = False, Optional bBrowseFiles As Boolean = False) As String
' Shows the Browse For Folder dialog
'
' hOwnerWnd     (Long)                     OwnerWindow.hWnd.
' sInstruct     (String)                   Instructions for user.
' vSelPath      (String or CSIDL Constant) Pre-select this Folder.
' vTopFolder    (String or CSIDL Constant) Set the Top folder.
'
' If successful, returns the selected folder's full path,
' returns an empty string otherwise.
Dim lRet As Long
Dim pidlRet As Long
Dim sPath As String * MAX_PATH
Dim lItemIDList As ItemIDList
Dim uBrowseInfo As BROWSEINFO
     
     With uBrowseInfo
         If bBrowseFiles Then
             .ulFlags = .ulFlags Or &H4000&
         End If
         If bFileSystemOnly Then
             .ulFlags = .ulFlags Or BIF_RETURNONLYFSDIRS
         End If
         ' The desktop will own the dialog
         .hOwner = hOwnerWnd
         ' This will be the dialog's root folder.
         If IsMissing(vTopFolder) Then
             vTopFolder = CSIDL_DESKTOP
         End If
         If Len(vTopFolder) > 0 And Not IsNumeric(vTopFolder) Then
             'String Path passed in
             .pidlRoot = SHSimpleIDListFromPath(CStr(vTopFolder))
         Else
             'Long CSIDL Special Folder Constant or Nothing passed in.
             lRet = SHGetSpecialFolderLocation(ByVal hOwnerWnd, ByVal CLng(vTopFolder), lItemIDList)
             .pidlRoot = lItemIDList.mkid.cb
         End If
         ' Set the dialog's prompt string
         .lpszTitle = sInstruct
         ' Obtain and set the address of the callback function
         .lpCallbackProc = FarProc(AddressOf BrowseCallbackProc)
         ' Obtain and set the pidl of the pre-selected folder
         If IsMissing(vSelPath) Or Len(vSelPath) = 0 Then
             'Nothing passed in
             .lParam = .pidlRoot
         ElseIf Len(vSelPath) > 0 And Not IsNumeric(vSelPath) Then
             'String Path passed in
             msStartPath = "C:\Documents and Settings\Саня\Рабочий стол\Новая папка\frmTest.frm" '"vSelPath
         Else
             'Long CSIDL Special Folder Constant passed in
             lRet = SHGetSpecialFolderLocation(ByVal hOwnerWnd, ByVal CLng(vSelPath), lItemIDList)
             .lParam = lItemIDList.mkid.cb
         End If
     End With
     
     ' Shows the browse dialog and doesn't return until the dialog is
     ' closed. The BrowseCallbackProc will receive all browse
     ' dialog specific messages while the dialog is open. pidlRet will
     ' contain the pidl of the selected folder if the dialog is not cancelled.
     pidlRet = SHBrowseForFolder(uBrowseInfo)
     
     If pidlRet > 0 Then
         ' Get the path from the selected folder's pidl returned
         ' from the SHBrowseForFolder call (rtns True on success,
         ' sPath must be pre-allocated!)
         If SHGetPathFromIDList(pidlRet, sPath) Then
           ' Return the path
           BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
         End If
         ' Free the memory the shell allocated for the pidl.
         Call CoTaskMemFree(pidlRet)
     End If
     
     ' Free the memory the shell allocated for the pre-selected folder.
     Call CoTaskMemFree(uBrowseInfo.lParam)
End Function

Public Function FarProc(lpProcName As Long) As Long

'Returns the value of the AddressOf operator
     FarProc = lpProcName
End Function