выбрать папку

[ivan-799]

Если не сложно, помогите, пожалуйста

Есть папка. В ней файлы(сколько - не известно). Все файлы имеют расширение *.xls или *.xlsx.

Нужно, чтобы при запуске макроса(для удобства пусть будет кнопкой) выскакивало дерево/меню в котором можно было бы выбрать папку(по умолчанию она не задана).

После выбора папки в столбцы A и B записываются значения ячеек A1 каждого файла и соответствующее ей название файла.

Ещё хотелось бы в ячейку F9 вывести цифрой общее кол-во файлов в папке.

[EducatedFool]

http://excelvba.ru/code/GetFileOrFolderPath
http://excelvba.ru/code/FilenamesCollection
По последней ссылке есть пример файла с макросом.

[EducatedFool]

Вам подойдет такой макрос:

Sub Main()
    Dim coll As Collection, ПутьКПапке As String
    ПутьКПапке = GetFolderPath(, ThisWorkbook.Path)   ' запрашиваем имя папки
    If ПутьКПапке = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки

    ' Ищем в папке все файлы XLS*, и выводим на лист список их имён.
    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, ".xls*", 1)

    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet: Set sh = ActiveSheet

    ' выводим результаты на лист
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к файлам
        With GetObject(coll(i))
            ЯчейкаA1 = .Worksheets(1).[a1]
            .Close False
        End With
        sh.Range("a" & sh.Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = _
        Array(Dir(coll(i)), ЯчейкаA1)     ' выводим на лист очередную строку
        DoEvents    ' временно передаём управление ОС
    Next
    sh.Range("a:b").EntireColumn.AutoFit    ' автоподбор ширины столбцов
    sh.Range("f9") = coll.Count ' кол-во файлов
End Sub

Пример в файле: http://excelvba.ru/XL_Files/Sample__...__21-51-13.zip

[ivan-799]

спасибо