asked on

VBA Scrip

hi
i try to run a macro on excel for getting the counts of items on a folder and sub folder, but i can got the subfolder item counts but i can not get the first folder, like c:\temp. please help, thanks

Sub test2()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
Dim count As Integer


'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Temp")
i = 1

   
    Cells(i, i) = "Path"
    Cells(i, 2) = "Items"
'loops through each file in the directory and prints their names and path
For Each objSubFolder In objFolder.Subfolders
    'print folder name
   Set colFiles = objSubFolder.Files
For Each colFile In colFiles
   
    count = count + 1
Next
    
    Cells(i + 1, 2) = count
    count = 0
    'print folder path
    Cells(i + 1, 1) = objSubFolder.path
    i = i + 1
Next objSubFolder
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Wayne Taylor (webtubbs)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

tristonyip

ASKER

it works nicely, thank you so much.

tristonyip

ASKER

Wayne
thanks for your help, I till have one more issue, the loop of the sub folders only go 1 level, I need all the sub folders to be list.
example c:\temp\test\doc

thank you so much.

Bill Prew

Give this a try.

Sub test2()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Temp")

    i = 1
    Cells(i, i) = "Path"
    Cells(i, 2) = "Items"
    
    Recurse objFolder    

End Sub

Sub Recurse(objFolder)
    'get folder count
    i = i + 1
    Cells(i, 2) = objFolder.Files.Count
    Cells(i, 1) = objFolder.Path
    
    'loops through each subfolder
    For Each objSubFolder In objFolder.Subfolders
        Recurse objSubFolder
    Next
End Sub

Open in new window

~bp

tristonyip

ASKER

Bill, thanks for your help, but your script only output the last sub folder, here is what i need . is it possible?

sample:
path        Items        lastModifyDate
C:\Temp        107        9/21/2015 16:57
C:\Temp\New folder        2        9/21/2015 16:57
C:\Temp\New folder\test1 3        9/21/2015 16:57
C:\Temp\New folder\test1\test2        1        9/28/2015 15:13
C:\Temp\New folder2      0        9/21/2015 16:57

Bill Prew

Okay, try this.

Sub test2()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Temp")

    i = 1
    Cells(i, 1) = "Path"
    Cells(i, 2) = "Items"
    
    Recurse objFolder, i   

End Sub

Sub Recurse(objFolder, i)
    'get folder count
    i = i + 1
    Cells(i, 1) = objFolder.Path
    Cells(i, 2) = objFolder.Files.Count
    
    'loops through each subfolder
    For Each objSubFolder In objFolder.Subfolders
        Recurse objSubFolder, i
    Next
End Sub

Open in new window

~bp

tristonyip

ASKER

Bill
thank you so much for the vb script, it works very nice, but I am facing an other issues, the script counts all files in folder, including hidden file like Thumbs.db, is it away to exclude those hidden file from the counts? i am appreciated your help.
thanks

Bill Prew

Okay, this will not count the HIDDEN files. See if this works better.

Sub test2()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Temp")

    i = 1
    Cells(i, 1) = "Path"
    Cells(i, 2) = "Items"
    
    Recurse objFolder, i

End Sub

Sub Recurse(ByRef objFolder As Object, i As Integer)
    Dim objSubFolder As Object
    
    'get folder count
    i = i + 1
    Cells(i, 1) = objFolder.Path
    Cells(i, 2) = GetFileCount(objFolder)
    
    'loops through each subfolder
    For Each objSubFolder In objFolder.Subfolders
        Recurse objSubFolder, i
    Next
End Sub

Function GetFileCount(ByRef objFolder As Object) As Double
   Const FileAttrNormal = 0
   Const FileAttrReadOnly = 1
   Const FileAttrHidden = 2
   Const FileAttrSystem = 4
   Const FileAttrVolume = 8
   Const FileAttrDirectory = 16
   Const FileAttrArchive = 32
   Const FileAttrAlias = 64
   Const FileAttrCompressed = 128

   GetFileCount = 0
   For Each objFile In objFolder.Files
      If (objFile.Attributes And FileAttrHidden) = 0 Then
         GetFileCount = GetFileCount + 1
      End If
   Next
End Function

Open in new window

~bp

tristonyip

ASKER

Bill
i got Compile error: ByRef argument type mismatch.

thanks

Bill Prew

Odd, I ran / run it here with no errors in Excel. You pasted in the full code I provided, not just pieces, right?

~bp

tristonyip

ASKER

Bill
my mistake, it works beautifully, thank you so much.

Bill Prew

Great.

~bp

tristonyip

ASKER

Bill
I am sorry to brother you again, my boss ask me to only count the doc and docx file, the is the vb i made the change , but the problem is taking to long to complete, do you have better ways? thanks for your help.

Function GetFileCount(ByRef objFolder As Object) As Double

Set objFSO = CreateObject("Scripting.FileSystemObject")
GetFileCount = 0
For Each objFile In objFolder.Files
'count only the doc and docx file

If objFSO.GetExtensionName(objFile) Like "doc*" Then
GetFileCount = GetFileCount + 1
End If
Next
End Function

Bill Prew

Try this:

Sub test2()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Temp")

    i = 1
    Cells(i, 1) = "Path"
    Cells(i, 2) = "Items"
    
    Recurse objFolder, i

End Sub

Sub Recurse(ByRef objFolder As Object, i As Integer)
    Dim objSubFolder As Object
    
    'get folder count
    i = i + 1
    Cells(i, 1) = objFolder.Path
    Cells(i, 2) = GetFileCount(objFolder)
    
    'loops through each subfolder
    For Each objSubFolder In objFolder.Subfolders
        Recurse objSubFolder, i
    Next
End Sub

Function GetFileCount(ByRef objFolder As Object) As Double
   Const FileAttrNormal = 0
   Const FileAttrReadOnly = 1
   Const FileAttrHidden = 2
   Const FileAttrSystem = 4
   Const FileAttrVolume = 8
   Const FileAttrDirectory = 16
   Const FileAttrArchive = 32
   Const FileAttrAlias = 64
   Const FileAttrCompressed = 128
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")

   GetFileCount = 0
   For Each objFile In objFolder.Files
      strExt = LCase(objFSO.GetExtensionName(objFile))
      If (objFile.Attributes And FileAttrHidden) = 0 And strExt = "doc" Or strExt = "docx" Then
         GetFileCount = GetFileCount + 1
      End If
   Next
   
   Set objFSO = Nothing

End Function

Open in new window

~bp

tristonyip

ASKER

yes, it runs a lot faster, thank you so much.

Bill Prew

Great, glad that helped.

~bp