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

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

Option Explicit
'
'   OpenFile
'
Dim fso As FileSystemObject
Dim myDic As Dictionary
'Event Declarations:
Event SelectFile(Filename As String) 'MappingInfo=Combo1,Combo1,-1,Click
'Default Property Values:
Const m_def_DialogStyle = 0
'------------------------------
 
'-------------  Вот они !
 
Const m_def_OFNFlags0 = OFNexplorer Or OFNNoChangeDir Or OFNEnableHook Or OFNEnableIncludeNotify Or OFNFILEMUSTEXIST
Const m_def_OFNFlags1 = OFNexplorer Or OFNNoChangeDir Or OFNEnableHook Or OFNEnableIncludeNotify Or OFNHIDEREADONLY Or OFNCreatePrompt
'------------------------
 
 
Const m_def_Title0 = "Открыть"
Const m_def_Title1 = "Сохранить как.."
Public Enum dlgStyle
    [Открыть] = 0
    [Сохранить как..] = 1
End Enum
'------------------------------------
Const m_def_FilterIndex = 0
Const m_def_Filter = "Любой файл|*.*|Мультимедиа wav/mp3/mp4/avi|*.wav*;*.mp3*;*.mp4*;*.avi*|"
'Property Variables:
Dim m_DialogStyle As Long
Dim m_Title As String
Dim m_OFNFlags As Long
Dim m_FilterIndex As Long
Dim m_Filter As String
 
Private Sub Combo1_Click()
    RaiseEvent SelectFile(Combo1.Text)
    Combo1.ToolTipText = Combo1.Text
End Sub
 
Private Sub Command1_Click()
    Dim f&, Filename$
    With OFN
 
        .lpstrFilter = Replace(Filter, "|", Chr$(0))
        .lpstrTitle = Title
        .nFilterIndex = FilterIndex
        Filename = mGetOpen.GetOpen(OFNFlags)
        
        If fso.FileExists(Filename) And Not myDic.Exists(Filename) Then
            myDic.Add Filename, ""
            For f = Combo1.ListCount - 1 To 0 Step -1
                Combo1.List(f + 1) = Combo1.List(f)
            Next
            Combo1.List(0) = Filename
            GoTo setFileName: 'Чтоб избежать повторных файлов
        ElseIf myDic.Exists(Filename) Then
setFileName:
            Combo1.Text = Filename
            Combo1.ToolTipText = Combo1.Text
            Combo1.SelStart = Len(Filename)
            RaiseEvent SelectFile(Filename)
        End If
    End With
End Sub
 
Private Sub UserControl_Initialize()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set myDic = CreateObject("Scripting.Dictionary"): myDic.CompareMode = TextCompare
    '-----------------------------
    Picture1.BorderStyle = 0
    Combo1.Text = ""
End Sub
 
Private Sub UserControl_Resize()
    Const q = 45
    On Error Resume Next
    With UserControl
        .Height = Combo1.Height + q * 7
        Frame1.Move 0, 0, .Width, .Height
        Picture1.Move q * 2, q * 5, .Width - q * 4, .Height - q * 6
    End With
    With Picture1
        Command1.Move .Width - Command1.Width - 0, 0, Command1.Width - 0, Combo1.Height
        Combo1.Move 0, 0, .Width - Command1.Width - q * 2
    End With
    
End Sub
 
 
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
 
    Frame1.Caption = PropBag.ReadProperty("FrameCaption", "Выбор файла")
    Command1.Caption = PropBag.ReadProperty("ButtonCaption", "Обзор")
    m_Filter = PropBag.ReadProperty("Filter", m_def_Filter)
    m_FilterIndex = PropBag.ReadProperty("FilterIndex", m_def_FilterIndex)
    m_OFNFlags = PropBag.ReadProperty("OFNFlags", m_def_OFNFlags0)
    m_Title = PropBag.ReadProperty("Title", m_def_Title0)
    m_DialogStyle = PropBag.ReadProperty("DialogStyle", m_def_DialogStyle)
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
 
    Call PropBag.WriteProperty("FrameCaption", Frame1.Caption, "Выбор файла")
    Call PropBag.WriteProperty("ButtonCaption", Command1.Caption, "Обзор")
    Call PropBag.WriteProperty("Filter", m_Filter, m_def_Filter)
    Call PropBag.WriteProperty("FilterIndex", m_FilterIndex, m_def_FilterIndex)
    Call PropBag.WriteProperty("OFNFlags", m_OFNFlags, m_def_OFNFlags0)
    Call PropBag.WriteProperty("Title", m_Title, m_def_Title0)
    Call PropBag.WriteProperty("DialogStyle", m_DialogStyle, m_def_DialogStyle)
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Frame1,Frame1,-1,Caption
Public Property Get FrameCaption() As String
    FrameCaption = Frame1.Caption
End Property
 
Public Property Let FrameCaption(ByVal New_FrameCaption As String)
    Frame1.Caption() = New_FrameCaption
    PropertyChanged "FrameCaption"
End Property
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Command1,Command1,-1,Caption
Public Property Get ButtonCaption() As String
    ButtonCaption = Command1.Caption
End Property
 
Public Property Let ButtonCaption(ByVal New_ButtonCaption As String)
    Command1.Caption() = New_ButtonCaption
    PropertyChanged "ButtonCaption"
End Property
 
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,Любой файл|*.*|
Public Property Get Filter() As String
    Filter = m_Filter
End Property
 
Public Property Let Filter(ByVal New_Filter As String)
    m_Filter = New_Filter
    PropertyChanged "Filter"
End Property
 
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Filter = m_def_Filter
    m_FilterIndex = m_def_FilterIndex
    m_OFNFlags = m_def_OFNFlags0
    m_Title = m_def_Title0
    m_DialogStyle = m_def_DialogStyle
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get FilterIndex() As Long
    FilterIndex = m_FilterIndex
End Property
 
Public Property Let FilterIndex(ByVal New_FilterIndex As Long)
    m_FilterIndex = New_FilterIndex
    PropertyChanged "FilterIndex"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,2,0
Public Property Get OFNFlags() As CdlgExt_Flags
    OFNFlags = m_OFNFlags
End Property
 
Public Property Let OFNFlags(ByVal New_OFNFlags As CdlgExt_Flags)
    m_OFNFlags = New_OFNFlags
    PropertyChanged "OFNFlags"
End Property
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,Открыть
Public Property Get Title() As String
    Title = m_Title
End Property
 
Public Property Let Title(ByVal New_Title As String)
    m_Title = New_Title
    PropertyChanged "Title"
End Property
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get DialogStyle() As dlgStyle
    DialogStyle = m_DialogStyle
End Property
 
Public Property Let DialogStyle(ByVal New_DialogStyle As dlgStyle)
    m_DialogStyle = New_DialogStyle
    Title = IIf(New_DialogStyle = Открыть, m_def_Title0, m_def_Title1)
    OFNFlags = IIf(New_DialogStyle = Открыть, m_def_OFNFlags0, m_def_OFNFlags1)
    PropertyChanged "DialogStyle"
End Property