Поиск файлов по размеру в директории и поддиректориях - VB

Формулировка задачи:

Всем привет! Пока новичок в этом деле, по этому сильно не пинайте если вопрос глупый. Нашел пример поиска файлов, подогнал его по своим нуждам, но ни как не могу решить один вопрос. Мне надо искать файлы не по названию, а по размеру, точнее все файлы с размером меньше или ровно 1000 байт. Возможно ли это реализовать на базе этого кода?
Option Explicit
 
Dim fso As New FileSystemObject
Dim fld As Folder
 
Private Sub Command1_Click()
   Dim nDirs As Long, nFiles As Long, lSize As Currency
   Dim sDir As String, sSrchString As String
   sDir = InputBox("Type the directory that you want to search for", _
                   "FileSystemObjects example", "C:\")
   sSrchString = InputBox("Type the file name that you want to search for", _
                   "FileSystemObjects example", "vb.ini")
   MousePointer = vbHourglass
   Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
   lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
   MousePointer = vbDefault
   MsgBox Str(nFiles) & " files found in" & Str(nDirs) & _
          " directories", vbInformation
   MsgBox "Total Size = " & lSize & " bytes"
End Sub
 
Private Function FindFile(ByVal sFol As String, sFile As String, _
   nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
                  vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, _
      FileName))
      nFiles = nFiles + 1
      List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

Код к задаче: «Поиск файлов по размеру в директории и поддиректориях - VB»

textual
option explicit
dim c as long
Private Sub Form_Load()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
c=0
Search FSO.GetFolder("C:\")
msgbox c
End Sub
 
Sub Search(Fold As Object)
Dim SubFold As Object
Dim File As Object
For Each File In Fold.Files
    If File.Size <= 1000 Then Debug.Print File.Path, File.Size:c=c+1
Next File
On Error GoTo ErrHandle
For Each SubFold In Fold.SubFolders
    Search SubFold
Next SubFold
Exit Sub
ErrHandle:
MsgBox "Нет допуска к папке """ & Fold.Path & """"
Err.Clear
End Sub

14   голосов, оценка 3.786 из 5


СОХРАНИТЬ ССЫЛКУ