Страницы: 1
RSS
Количество файлов в папке с указанным расширением.
 
Добрый день.

Подскажите, пожалуйста, логику алгоритма подсчета количества файлов определенного типа в папке. Посчитать все файлы получается. А вот с указанным расширением ни как. Не могу понять принцип.
Код
Dim X As Variant
X = TextBox1.Text

Set FSO = CreateObject("Scripting.FileSystemObject")
Y = FSO.GetFolder(X).Files.Count

MsgBox Y
 
Проверять имя файлов на содержание нужных символов, после чего сделать обычный счетчик i++, который можно вывести.
Изменено: PDO - 11.08.2019 11:07:04
 
использовать другой объект https://www.script-coding.com/WSH/Shell.html#5.3.3.
или в цикле перебирать и считать нужные.
По вопросам из тем форума, личку не читаю.
 
Можно без лишних объектов:
Код
Sub testDirFunction()
    Dim counter
    Dim fn
    
    ChDir Environ("homepath") & Application.PathSeparator & _
        "Downloads"
        
    fn = Dir("*.xlsx")
    counter = 0
    
    While Len(fn) > 0
    
    counter = counter + 1
    fn = Dir()
    Wend
    MsgBox "Total count: " & counter
End Sub
С уважением,
Федор/Все_просто
 
Цитата
Все_просто написал:
Можно без лишних объектов:
можно, но не проще
Код
X = TextBox1.Text
Set objFolderItems = CreateObject("Shell.Application").Namespace(X).Items()
objFolderItems.Filter 64, "*.xlsx"
MsgBox "Total count: " &  objFolderItems.Count
По вопросам из тем форума, личку не читаю.
 
БМВ,
благодарю. Круто, конечно.

Вот только как научится это понимать самому...
 
Навыки программирования плюс практика и еще раз практика (посмотрите на число сообщений Михаила). :)
В #5 использован синхронный метод Filter, поэтому не нужны "подпрыжки" с задержками, которые мы обычно видим в примерах с Shell.Application.
Функция dir из #4 не справится, если в пути к папке или именах файлов будут символы, которые не вписываются в кодовую страницу Windows по умолчанию.
Владимир
 
Цитата
sokol92 написал:
(посмотрите на число сообщений Михаила).  
да просто разговорчивый медведь попался, особенно когда пыхнет  :D
По вопросам из тем форума, личку не читаю.
 
Будете у нас в Ростове, милости просим заходите на плюшки)
 
Может пригодится, пересчитывает все расширения в указанной папке.
Код
Sub main()
    Dim objFSO As Object
    Dim ifile As Object, ipath$, txt$
    Dim objDic As Object, ikey
    ipath = "Путь к папке"
    Set objFSO = CreateObject("scripting.filesystemobject")
    Set objDic = CreateObject("Scripting.Dictionary")
    For Each ifile In objFSO.GetFolder(ipath).Files
        txt = Right(ifile.Name, Len(ifile.Name) - InStrRev(ifile.Name, "."))
        objDic.Item(txt) = objDic.Item(txt) + 1
    Next ifile
    txt = ""
    For Each ikey In objDic.Keys
        txt = txt & ikey & " : " & objDic.Item(ikey) & "шт." & vbNewLine
    Next
    MsgBox txt
End Sub
Изменено: Nordheim - 12.08.2019 13:16:24
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Все_просто написал:
Можно без лишних объектов:
вот, по этим мотивам сделал макрос вставляющий строки сверху шапки в зависимости от кол-ва файлов в папке:
Код
' проверяем кол-во файлов в папке, и если их больше возможного- вставляем строки
' чтобы неналазило на таблицу
Sub ВставкаСтрок()
    Dim counter
    Dim fn
    Dim myFSO As Object, myFolder As Object, myFile As Object
    
    
    If ActiveSheet.Name = "спецификация" Then
     Set c_naim = ActiveSheet.Cells.Find(what:="Наименование товара", LookAt:=xlWhole)
        naim_row = c_naim.Row
      End If
      
      
     '3. Создание объекта для работы с папками и файлами.
    Set myFSO = CreateObject(Class:="Scripting.FileSystemObject")
 
    ChDir myFSO.GetFolder(ActiveWorkbook.Path)
    
    fn = Dir("*.xls")
    counter = 0
     
    While Len(fn) > 0
     
    counter = counter + 1
    fn = Dir()
    Wend
    ' счётчик файлов: counter
    'макс. возиможное колическтво: naim_row - 6
    'сколько строк вставляем: counter - naim_row - 6  
    
    
    'eсли макс возможное меньше или равно счетчику:
    
   If naim_row - 6 <= counter - 1 Then
   
   
   ' то сумма строк будет равна :
            counter_ins_row = counter - (naim_row - 6)
            For i = 1 To counter_ins_row
                Rows(naim_row).Insert
            Next
        End If       
   ' Stop
End Sub


Все_просто, спасибо за идею, выручили сильно,- спасибо! чмоки)
зы: только этот макрос отдельно не запускался из другого, писал: "отсутствует макрос такойто..."... пришлось вписать в основной.
Изменено: Советник I категории - 24.01.2020 12:11:46
Страницы: 1
Наверх