Функция выбора папки с файлами, с сохранением предыдущего значения

Функция GetFolder вызывает диалоговое окно выбора папки в макросах на VBA.

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

Чтобы не тревожить пользователя диалоговым окном выбора папки при каждом запуске макроса,
описываемая в статье функция GetFolder сохраняет в реестре путь к ранее выбранной папке,
и при повторном обращении выводит сохранённый путь.

Есть способ принудительно вызвать диалоговое окно выбора папки.

Пример использования функции:

Sub ПримерИспользования_GetFolder()
    folder$ = GetFolder()    ' запрашиваем имя папки
    If folder$ = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки

    MsgBox "Выбрана папка: " & folder$, vbInformation
End Sub

Sub ПримерВыбораНесколькихПапок()
    On Error Resume Next: Err.Clear
    folder_1$ = GetFolder(1, , "Выберите папку с заявками")    ' запрашиваем имя папки 1
    If folder_1$ = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки

    folder_2$ = GetFolder(2, , , folder_1$)  ' запрашиваем имя папки 2 (начиная обзор с папки folder_1)
    If folder_2$ = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки

    ' запрашиваем имя папки 3 (каждый раз выводится диалоговое окно)
    folder_3$ = GetFolder(, True, "Выберите папку для сохранения результата")
    If folder_3$ = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки

 
    ' ваш код макроса, с использованием выбранных папок
    ' ...
End Sub

Смотрите также более простую функцию для выбора папки и функции для диалогового окна выбора файлов.

Код функции GetFolder, и вспомогательного макроса для изменения ранее сохранённого пути к папке:

Sub ChangeFolder()    ' для отдельной кнопки - если вдруг надо поменять ранее выбранную папку
    On Error Resume Next: GetFolder , True
End Sub
 
Function GetFolder(Optional ByVal FolderIndex& = 0, Optional ByVal ShowDialog As Boolean = False, _
                   Optional ByVal Title$ = "Выберите папку", Optional ByVal InitialFolder$) As String
    ' При первом вызове выводит диалогое окно выбора папки
    ' Запоминает выбранную папку, и при следующих вызовах диалоговое окно не выводит,
    ' а возвращает путь к ранее выбиравшейся папке
    ' Используйте вызов с параметром ShowDialog=TRUE для принудительного отображения диалогового окна
    On Error Resume Next: Err.Clear
    ProjectName$ = IIf(Len(PROJECT_NAME$) > 0, PROJECT_NAME$, "SelectFolder")
    PreviousFolder$ = GetSetting(Application.Name, ProjectName$, "folder" & FolderIndex&, "")
    If Len(PreviousFolder$) > 0 And Not ShowDialog Then
        If Dir(PreviousFolder$, vbDirectory) <> "" Then GetFolder = PreviousFolder$: Exit Function
    End If
 
    If InitialFolder$ = "" Then
        If Len(PreviousFolder$) > 0 And Dir(PreviousFolder$, vbDirectory) <> "" Then
            InitialFolder$ = PreviousFolder$    ' начинаем обзор с ранее выбранной папки
        Else
            InitialFolder$ = ThisWorkbook.Path & "\"    ' начинаем с текущей папки
        End If
    End If
 
    With Application.FileDialog(msoFileDialogFolderPicker)    ' вывод диалогового окна
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialFolder$
        If .Show <> -1 Then Exit Function    ' если пользователь отказался от выбора папки
        GetFolder = .SelectedItems(1)
        If Not Right$(GetFolder, 1) = "\" Then GetFolder = GetFolder & "\"
        SaveSetting Application.Name, ProjectName$, "folder" & FolderIndex&, GetFolder
    End With
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Сергей, есть же всё в примерах использования:

  ' запрашиваем имя папки 3 (каждый раз выводится диалоговое окно)
    folder_3$ = GetFolder(, True, "Выберите папку для сохранения результата")

Подскажите, куда именно вставить "ShowDialog=TRUE" чтобы каждый раз выбирать папку.

Нет, все макросы только для Excel.
C OpenOffice они не совместимы.

Эти макросы могут подойти для OpenOffice?

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   ___   __   __            __     __      _       
( _ ) \ \ / / __ __ \ \ / / __| | ____
/ _ \ \ V / \ \ /\ / / \ \ / / / _` | |_ /
| (_) | | | \ V V / \ V / | (_| | / /
\___/ |_| \_/\_/ \_/ \__,_| /___|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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