Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
18.04.2024, 20:19:19

Войти
Интересные и полезные статьи по работе с Excel и VBA можно найти в разделе ХИТРОСТИ
33 242 Сообщений в 5 457 Тем от 6 758 Пользователей
Последний пользователь: Сергей2662
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Расчёт количества файлов в папке без учёта скрытых файлов
Страниц: [1]   Вниз
Печать
Автор Тема: Расчёт количества файлов в папке без учёта скрытых файлов  (Прочитано 11092 раз)
0 Пользователей и 1 Гость смотрят эту тему.
dfc
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 9


Просмотр профиля E-mail
« : 10.10.2013, 12:33:34 »

Здравствуйте,
прошу помочь решить проблему.
В папке С:\Orders\ сохраняются заявки в формате .xlsx
Стоит задача посчитать при помощи макроса количество заявок находящихся в указанной папке без учёта скрытых файлов (резервных копий открытых книг) и вывести результат в ячейку рабочей книги.
Сейчас использую макрос:
Код: (vb)
Sub Orders()
    FolderPath = "C:\Orders\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Ord# = FSO.GetFolder(FolderPath).Files.Count
    Range("A1").Select
    ActiveCell.FormulaR1C1 = Ord#
End Sub

Но если какие-то книги из указанной папки остались открытыми во время расчёта, следствием чего является наличие в папке скрытых временных резервных копии этих фалов, то они тоже учитываются при подсчёте количества файлов, а это ненужно.
« Последнее редактирование: 11.10.2013, 19:00:52 от vikttur » Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 831



Просмотр профиля WWW
« Ответ #1 : 10.10.2013, 12:53:19 »

Используйте теги VBA Code для оформления кодов.

Таким методом как у Вас врядли получится. Можно подсчитывать через перебор, исключая файлы с атрибутом скрытые:
Просмотреть все файлы в папке

Код: (vb)
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        If GetAttr(sFolder & sFiles) <> vbHidden Then li = li + 1
        sFiles = Dir
    Loop
    ActiveCell.Value = li
    Application.ScreenUpdating = True
End Sub
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
dfc
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 9


Просмотр профиля E-mail
« Ответ #2 : 11.10.2013, 11:04:01 »

Большое спасибо! Работает. В ходе поиска решения получил ещё один работающий вариант. Привожу для информации:
Код: (vb)

Sub Orders()
  Dim c As Long
  [a1] = 0
  If Dir("C:\Orders\*.xlsx") = "" Then Exit Sub Else c = 1
  Do
    If Dir = "" Then Exit Do Else c = c + 1
  Loop Until False
  [a1] = c
End Sub

от IgorGo
http://www.programmersforum.ru/showthread.php?p=1284623#post1284623
« Последнее редактирование: 11.10.2013, 19:00:28 от vikttur » Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 831



Просмотр профиля WWW
« Ответ #3 : 11.10.2013, 11:16:39 »

Замечание №2. Оформляйте коды тегами. Или мне за Вас это делать надо?
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
dfc
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 9


Просмотр профиля E-mail
« Ответ #4 : 11.10.2013, 12:00:26 »

Извиняюсь. За меня не нужно. Разобрался.
Код: (vb)
Sub Orders()
  Dim c As Long
  [a1] = 0
  If Dir("C:\Orders\*.xlsx") = "" Then Exit Sub Else c = 1
  Do
    If Dir = "" Then Exit Do Else c = c + 1
  Loop Until False
  [a1] = c
End Sub
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru