buvanamali
New member
- Joined
- Aug 26, 2016
- Messages
- 4
- Reaction score
- 0
- Points
- 0
- Excel Version(s)
- 2007
Dear Sir / Madam
I am a newbie to VBA macros. I found the following macro on the internet, which is very much useful, accurate and perfect. As I am not conversant with VBA, I request you to help me in getting the count of files in a folder file extension type wise as attached in the sample workbook.
Thanks in Advance
Buvanamali
I am a newbie to VBA macros. I found the following macro on the internet, which is very much useful, accurate and perfect. As I am not conversant with VBA, I request you to help me in getting the count of files in a folder file extension type wise as attached in the sample workbook.
Thanks in Advance
Buvanamali
Code:
Function CountFiles_FolderAndSubFolders(strFolder As String, Optional strExt As String) As Double
'Original Author: Ken Puls (www.excelguru.ca)
'http://www.excelguru.ca/content.php?139-Count-Files-%28with-a-specific-extension-or-not%29-in-a-folder-and-subfolders
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolder As Object
Dim PosOfLastDot As Long
Dim IncludeSubFolders As Boolean
On Error GoTo EarlyExit
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
PosOfLastDot = InStrRev(objFile, ".") 'to find the position of the last dot
If (objFile.Attributes And vbHidden) = False Then 'if you list your documents folder (windows 7). there is hidden folders with shortcut arrows, will be skipped, but with a message "Permission denied", and carry on
If strExt = "" Or (UCase(Right(objFile.path, (Len(objFile.path) - InStrRev(objFile.path, ".")))) = UCase(strExt)) Then
CountFiles_FolderAndSubFolders = CountFiles_FolderAndSubFolders + 1
Else
If Right(objFile, Len(objFile) - PosOfLastDot) = strExt Or (UCase(Right(objFile.path, (Len(objFile.path) - InStrRev(objFile.path, ".")))) = UCase(strExt)) Then
CountFiles_FolderAndSubFolders = CountFiles_FolderAndSubFolders + 1
End If
End If
End If
Next objFile
IncludeSubFolders = True 'change to False if you want to list only the parent folder
If IncludeSubFolders = True Then
For Each objSubFolder In objFolder.SubFolders
CountFiles_FolderAndSubFolders = CountFiles_FolderAndSubFolders + CountFiles_FolderAndSubFolders(objSubFolder.path, strExt)
Next objSubFolder
End If
Exit Function
EarlyExit:
MsgBox Err.Description
Set objFile = Nothing
Set objSubFolder = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
On Error GoTo 0
End Function
Sub CountFiles()
'Original Author: Ken Puls (www.excelguru.ca)
'http://www.excelguru.ca/content.php?139-Count-Files-%28with-a-specific-extension-or-not%29-in-a-folder-and-subfolders
Dim dblCount As Double
dblCount = CountFiles_FolderAndSubFolders("D:\DESKTOP\Mali", "xltx") 'put your extention between the last 2 "". Will list all files if left like this, also change your folder
Range("B23").Value = dblCount
End Sub
Attachments
Last edited by a moderator: