nguyenanhdung8111982
Thành viên hoạt động
- Tham gia
- 1/11/19
- Bài viết
- 120
- Được thích
- 33
- Giới tính
- Nam
Em có đoạn code như dưới dùng để đếm tổng số file hình có đuôi mở rộng là '.jpg' hoặc '.JPG' trong từng subfolder. em đếm khoảng 17k hình. nhờ anh chị giúp chỉnh sửa code để chạy nhanh hơn!!!
Trân trọng,
Nguyen Anh Dung
Mã:
Sub DemfileJPG1()
Application.ScreenUpdating = False
Dim FolderName As String
Sheets("sheet1").Select
Cells(1, 1).Value = 2
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
'.Title = "Select an image file"
.Show
'.AllowMultiSelect = True
.Filters.Clear
'.Filters.Add "JPG", ".JPG"
'.Filters.Add "JPEG File Interchange Format", ".JPEG"
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
ListFolders (FolderName)
Application.ScreenUpdating = True
MsgBox "Done" & vbCrLf & "Total files found: " & Cells(1, 1).Value
Cells(1, 1).Value = "Source"
Cells(1, 2).Value = "Folder"
Cells(1, 3).Value = "Subfolder"
Cells(1, 4).Value = "FileCount"
End Sub
Sub ListFolders(Fldr As String)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim fl1
Set fl1 = CreateObject("Scripting.FileSystemObject")
Dim fl2
Set fl2 = CreateObject("Scripting.FileSystemObject")
Set fl1 = fs.GetFolder(Fldr)
For Each fl2 In fl1.SubFolders
Cells(Cells(1, 1).Value, 1).Value = Replace(Fldr, fl1.Name, "")
Cells(Cells(1, 1).Value, 2).Value = fl1.Name
Cells(Cells(1, 1).Value, 3).Value = fl2.Name
Cells(Cells(1, 1).Value, 4).Value = CountFiles(Fldr & "\" & fl2.Name)
Cells(1, 1).Value = Cells(1, 1).Value + 1
ListFolders fl2.Path
Next
End Sub
Private Function CountFiles(strDirectory As String, Optional strExt As String = ".JPG", Optional strExt1 As String = ".jpg") As Double
'Private Function CountFiles(strDirectory As String, Optional strExt As String = ".JPG") As Double
'Author : Ken Puls (www.excelguru.ca)
'Function purpose: To count files in a directory. If a file extension is provided,
' then count only files of that type, otherwise return a count of all files.
Dim objFSO As Object
Dim objFiles As Object
Dim objFile As Object
'Set Error Handling
On Error GoTo EarlyExit
'Create objects to get a count of files in the directory
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFSO.GetFolder(strDirectory).Files
'Count files (that match the extension if provided)
'If strExt = "*.*" Then
'If strExt <> ".jpg" Or strExt1 <> ".JPG" Then
'If strExt = ".JPG" Or strExt1 = ".jpg" Then
'If strExt = ".JPG" Then
If strExt = ".csv" Then
'If strExt = ".JPG" Then
CountFiles = objFiles.Count
Else
For Each objFile In objFiles
'If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".")))) = UCase(strExt) Then
'If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".JPG")))) = UCase(strExt) Then
If Right(objFile.Path, 4) = ".JPG" Or Right(objFile.Path, 4) = ".jpg" Then
'If UCase(objFile.Path) Like ".JPG" Then
CountFiles = CountFiles + 1
End If
Next objFile
'Loop
End If
EarlyExit:
'Clean up
On Error Resume Next
Set objFile = Nothing
Set objFiles = Nothing
Set objFSO = Nothing
On Error GoTo 0
End FunctionNguyen Anh Dung
