Dùng code gì để đếm tổng số file trong thư mục (bao gồm thư mục con) với tốc độ cao (2 người xem)

[ndu96081631]

Thông thường để đếm tổng số file có trong 1 thư mục, ta dùng 2 cách sau:
1> Cách 1: FileSearch

Sub Test1()
  Dim sPath As String
  With CreateObject("Shell.Application")
    sPath = .BrowseForFolder(0, "", 1).Self.Path
  End With
  With Application.FileSearch
    .NewSearch
    .SearchSubFolders = True
    .LookIn = sPath
    .FileType = msoFileTypeAllFiles
    .Filename = "*.*"
    .Execute
    MsgBox .FoundFiles.Count
  End With
End Sub

2> Cách 2: FileSystemObject

Dim iCount As Long
Private Sub CountFiles(sPath As String)
  Dim SubFld
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(sPath)
      iCount = iCount + .Files.Count
      For Each SubFld In .SubFolders
        CountFiles SubFld.Path
      Next
    End With
  End With
End Sub

Sub Test2()
  Dim sPath As String
  iCount = 0
  With CreateObject("Shell.Application")
    sPath = .BrowseForFolder(0, "", 1).Self.Path
  End With
  CountFiles sPath
  MsgBox iCount
End Sub

Dù là cách gì thì cảm giác tốc độ cũng không cao lắm! Trong đó cách 2 cho tốc độ nhanh hơn cách 1
Nhưng.... Tôi muốn 1 code nào đó cho tốc độ nhanh hơn
Để ý khi ta click phải 1 folder trong của sổ Explorer rồi chọn Properties thì mọi thông tin của folder gần như hiện ra tức khắc, trong đó có thông tin về tổng số files



-------------------------------------------------------------------------------------
- Không biết Windows đã dùng cách gì mà cho tốc độ tính toán nhanh đến như vậy nhỉ?
- Trong các hàm API, không biết có hàm nào xử lý việc đếm file không?
- Ngoài 2 cách đếm file như trên, không biết còn có cách nào khác cho tốc độ nhanh hơn không?
-------------------
Các cao thủ ai biết vấn đề này xin chỉ giáo giúp!
Cảm ơn!

 

[rollover79]

Window thì lần đầu tiên vẫn phải tính toán như thường, chỉ có từ lần thứ 2 trở đi nó mới hiện ra tức thời. Đó có thể là cơ chế lưu lại vào đâu đó của Window thôi.

 

[ndu96081631]

Nhờ các bạn kiểm tra giúp

Nhờ các bạn kiểm tra giúp tôi code này:

Public FleCount As Long, FldCollect
Private Sub GetFolderList(FolderName As String, InSub As Boolean)
  Dim SubFld
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(FolderName)
      FleCount = FleCount + .Files.Count
      FldCollect.Add .Path, ""
      If InSub Then
        For Each SubFld In .SubFolders
          GetFolderList SubFld.Path, True
        Next
      End If
    End With
  End With
End Sub

Sub Main()
  Dim FolderName As String, TG As Double
  On Error GoTo ExitSub
  Set FldCollect = CreateObject("Scripting.Dictionary")
  FleCount = 0
  With CreateObject("Shell.Application")
    FolderName = .BrowseForFolder(0, "", 1).Self.Path
  End With
  TG = Timer
  GetFolderList FolderName, True
  With Range("A:A")
    '.ClearContents
    '.Resize(Dic.Count) = WorksheetFunction.Transpose(Dic.Keys)
  End With
  Range("B1") = FleCount
  MsgBox Format(Timer - TG, "0.000000000")
ExitSub:
End Sub

Các bạn giúp tôi tải file đính kèm về và chạy thử xem trường hợp lấy toàn bộ list folder của ổ C hoặc D là bao nhiêu giây?
Tôi kiểm tra trên máy mình, cứ lần đầu mở file luôn cho tốc độ rất chậm! Chỉ từ lần thứ 2 trở đi thì tốc độ mới nhanh!

 

[ndu96081631]

Ah... mình tìm ra cách rồi ---> Dùng lệnh DOS
dir C:\ /b /a-d /o /s | find /c /v ""
Còn việc đưa mấy lệnh này vào VBA như thế nào thì... quá dễ!
Cảm ơn các bạn đã quan tâm

 

[xsatteam]

Ah... mình tìm ra cách rồi ---> Dùng lệnh DOS
dir C:\ /b /a-d /o /s | find /c /v ""
Còn việc đưa mấy lệnh này vào VBA như thế nào thì... quá dễ!
Cảm ơn các bạn đã quan tâm

bác ởi chỉ bảo thêm đi , em thấy không dễ chút nào !

 

[ndu96081631]

bác ởi chỉ bảo thêm đi , em thấy không dễ chút nào !

Nguyên tắc nằm ở dòng lệnh DOS mà tôi đã nói ở trên, còn việc dùng nó thế nào là do khả năng tùy biến của mỗi người
Gữi file tôi làm cho bạn tham khảo... Tôi xây dựng 1 form để dễ thao tác. Form có hình dạng như sau



1> Code trong Module

Function CountFiles(sFolder As String, InSub As Boolean, Ext As String) As Long
  Dim sFilename As String, sCommand As String
  On Error Resume Next
  If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
  sFolder = """" & Replace(sFolder, "\", """\""") & """"
  If Ext <> "" Then Ext = "*." & Ext
  sCommand = "cmd /c dir " & sFolder & Ext & " /b /a-d /o " & IIf(InSub, "/s", "") & " | find /c /v """" > "
  With CreateObject("Scripting.FileSystemObject")
    sFilename = .GetTempName
    CreateObject("Wscript.Shell").Run sCommand & sFilename, 0, True
    CountFiles = .OpenTextFile(sFilename, 1).Readline
    .DeleteFile sFilename
  End With
End Function

Sub Main()
  UserForm1.Show
End Sub

2> Code trong UserForm

Private Sub cboFolder_DropButtonClick()
  Dim sFolder As String
  On Error Resume Next
  With CreateObject("Shell.Application")
    sFolder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  With cboFolder
    If TypeName(sFolder) = "String" Then .Text = sFolder
    .Enabled = False: .Enabled = True
  End With
End Sub

Private Sub cmdSrch_Click()
  Dim Total As Long, Dur As Double
  On Error GoTo ExitSub
  Dur = Timer
  If CreateObject("Scripting.FileSystemObject").FolderExists(cboFolder.Value) Then
    Total = CountFiles(cboFolder.Text, chkInSub.Value, txtExt.Text)
    MsgBox Total & " files found!", , Format(Timer - Dur, "0.000000000")
  Else
    MsgBox "The path doesn't exist!"
  End If
ExitSub:
End Sub

--------------
Bạn có thể tham khảo thêm bài này để biết cách tìm kiếm chi tiết (liệt ra kết quả tìm kiếm):
http://www.giaiphapexcel.com/forum/showthread.php?7146-%C4%90%E1%BB%91-vui-v%E1%BB%81-VBA%21&p=291700#post291700

 

[xsatteam]

CODE Của bác, em chưa đủ trình để hiểu , xin mạo muội post code này , đã test


Sub Demo()

MsgBox FileCountA("C:\temp\")
MsgBox FileCountB("C:\temp\")

End Sub

Function FileCountA(Path As String) As Long
Dim strTemp As String
Dim lngCount As Long

strTemp = Dir(Path & "*.*")
Do While strTemp <> ""
lngCount = lngCount + 1
strTemp = Dir
Loop

FileCountA = lngCount

End Function
Function FileCountB(Path As String) As Long

Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
FileCountB = objFSO.Files.Count

Set objFSO = Nothing

End Function

 

[ndu96081631]

CODE Của bác, em chưa đủ trình để hiểu , xin mạo muội post code này , đã test

  MsgBox FileCountA("C:\temp\")
  MsgBox FileCountB("C:\temp\")
End Sub

Function FileCountA(Path As String) As Long
  Dim strTemp As String
  Dim lngCount As Long
  strTemp = Dir(Path & "*.*")
  Do While strTemp <> ""
    lngCount = lngCount + 1
    strTemp = Dir
  Loop
  FileCountA = lngCount
End Function

Function FileCountB(Path As String) As Long
  Dim objFSO As Object
  Set objFSO = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
  FileCountB = objFSO.Files.Count
  Set objFSO = Nothing
End Function

Code này chưa xài được đâu bạn ơi
- Thứ nhất: Nó chưa tìm được trong thư mục con
- Thứ hai: Nó chưa phân loại được các kiểu file mà ta cần tìm (đâu phải lúc nào người dùng cũng muốn tìm tất cả các kiểu file)
- Thứ ba: Với hàm DIR thì.. phải xem lại ---> Nó sẽ bị "đơ" ngay với tên thư mục là tiếng Việt có dấu
- Thứ tư: Chưa bẫy lỗi
vân vân... và... vân vân...
Nói chung còn phải sửa rất nhiều mới dùng được
-------------
Ngoài ra, tôi không nghĩ rằng code của tôi lại quá khó hiểu... chẳng qua chỉ là phương pháp chuyển từ lệnh DOS sang VBA thôi mà (cần tìm search google sẽ có cả đóng)
Nói chung: Bài toán duyệt file trong thư mục đã từng được đề cập nhiều lần trên diễn đàn rồi... và các cao thủ cũng đã có những giải pháp rất hay! Ở đây tôi chỉ muốn tìm 1 phương pháp khác sao cho tối ưu nhất về mặt tốc độ ---> Về điểm này thì chắc chẳng có món nào qua mặt nỗi DOS COMMAND đâu nha

 

[xsatteam]

Function CountFiles(sFolder As String, InSub As Boolean, Ext As String) As Long
Dim sFilename As String, sCommand As String
On Error Resume Next
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
sFolder = """" & Replace(sFolder, "\", """\""") & """"
If Ext <> "" Then Ext = "*." & Ext
sCommand = "cmd /c dir " & sFolder & Ext & " /b /a-d /o " & IIf(InSub, "/s", "") & " | find /c /v """" > "
With CreateObject("Scripting.FileSystemObject")
sFilename = .GetTempName
CreateObject("Wscript.Shell").Run sCommand & sFilename, 0, True
CountFiles = .OpenTextFile(sFilename, 1).Readline
.DeleteFile sFilename
End With
End Function

bác có thể huớng dẫn cụ thể hơn ,

khi sử dụng trong vba thì cú pháp gọi hàm này như thế nào hoặc khi dùng trong cell A1 thì cú pháp thế nào không ạ

 

[ndu96081631]

bác có thể huớng dẫn cụ thể hơn ,

khi sử dụng trong vba thì cú pháp gọi hàm này như thế nào hoặc khi dùng trong cell A1 thì cú pháp thế nào không ạ

Thì cú pháp trong code đấy:

Function CountFiles(sFolder, InSub, Ext)

Tức

Function CountFiles(Đường dẫn, Thư mục con, kiểu file)

Ví dụ: Bạn muốn tính tổng số file trong thư mục: D:\Excel bao gồm cả thư mục con và kiểu file là xls... vậy cú pháp là:

=CountFiles("D:\Excel",TRUE,"xls")

Trong VBA cũng y chang thế thôi

 

[xsatteam]

trên cả tuyệt vời , thank bác !

 

[yvsusu]

Cảm ơn bạn ndu96081631 về bài viết. Mình thấy bài viết của bạn rất hữu ích. Mình có thêm 1 câu hỏi. Nếu mình muốn liệt kê danh sách các file đã tìm thấy và đường link để mở file đó, việc làm này có thực hiện được không?

 

[yvsusu]

Nếu làm được thì mình phải làm như nào?

 

[trantonghai]

Nhờ các bạn kiểm tra giúp

Nhờ các bạn kiểm tra giúp tôi code này:

Public FleCount As Long, FldCollect
Private Sub GetFolderList(FolderName As String, InSub As Boolean)
  Dim SubFld
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(FolderName)
      FleCount = FleCount + .Files.Count
      FldCollect.Add .Path, ""
      If InSub Then
        For Each SubFld In .SubFolders
          GetFolderList SubFld.Path, True
        Next
      End If
    End With
  End With
End Sub

Sub Main()
  Dim FolderName As String, TG As Double
  On Error GoTo ExitSub
  Set FldCollect = CreateObject("Scripting.Dictionary")
  FleCount = 0
  With CreateObject("Shell.Application")
    FolderName = .BrowseForFolder(0, "", 1).Self.Path
  End With
  TG = Timer
  GetFolderList FolderName, True
  With Range("A:A")
    '.ClearContents
    '.Resize(Dic.Count) = WorksheetFunction.Transpose(Dic.Keys)
  End With
  Range("B1") = FleCount
  MsgBox Format(Timer - TG, "0.000000000")
ExitSub:
End Sub

Các bạn giúp tôi tải file đính kèm về và chạy thử xem trường hợp lấy toàn bộ list folder của ổ C hoặc D là bao nhiêu giây?
Tôi kiểm tra trên máy mình, cứ lần đầu mở file luôn cho tốc độ rất chậm! Chỉ từ lần thứ 2 trở đi thì tốc độ mới nhanh!

Bài đã được tự động gộp: 17/12/18

Nhờ các bạn kiểm tra giúp

Nhờ các bạn kiểm tra giúp tôi code này:

Public FleCount As Long, FldCollect
Private Sub GetFolderList(FolderName As String, InSub As Boolean)
  Dim SubFld
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(FolderName)
      FleCount = FleCount + .Files.Count
      FldCollect.Add .Path, ""
      If InSub Then
        For Each SubFld In .SubFolders
          GetFolderList SubFld.Path, True
        Next
      End If
    End With
  End With
End Sub

Sub Main()
  Dim FolderName As String, TG As Double
  On Error GoTo ExitSub
  Set FldCollect = CreateObject("Scripting.Dictionary")
  FleCount = 0
  With CreateObject("Shell.Application")
    FolderName = .BrowseForFolder(0, "", 1).Self.Path
  End With
  TG = Timer
  GetFolderList FolderName, True
  With Range("A:A")
    '.ClearContents
    '.Resize(Dic.Count) = WorksheetFunction.Transpose(Dic.Keys)
  End With
  Range("B1") = FleCount
  MsgBox Format(Timer - TG, "0.000000000")
ExitSub:
End Sub

Các bạn giúp tôi tải file đính kèm về và chạy thử xem trường hợp lấy toàn bộ list folder của ổ C hoặc D là bao nhiêu giây?
Tôi kiểm tra trên máy mình, cứ lần đầu mở file luôn cho tốc độ rất chậm! Chỉ từ lần thứ 2 trở đi thì tốc độ mới nhanh!

 

[thaitv0302]

Xin code VBA đếm file trong nhiều thư mục chứa các thư mục con
List tên folder ra Excel và đếm só file trong folder đó. Nhờ các cao nhân chỉ giúp
Xin cảm ơn!