Solved

Counting folder using API

Posted on 2001-08-27
16
476 Views
Last Modified: 2008-06-15
I intend to count the folder given a path using API function. I tried to use file system object before but it always give me out of memory problem. Therefore I seek the API function for my solution. Is there any API function available to count the number of subfolders given a folder path? If yes, pls provide the coding on how to call the API function and include any dll?
0
Comment
Question by:MarcusAu
  • 5
  • 5
  • 3
  • +3
16 Comments
 

Expert Comment

by:abhi_panickar
Comment Utility

Using The Filesytem Object u can pretty much do anything with the local file sytem . I dont have any idea how u had used the filesystem object to get the out of memory error...well here i have used a recursive procedure that calls itself.....Try the below code...hopes it helps you..
Bye....





Option Explicit
' Needs a referance to Microsoft Scripting Runtime
' And a Command Button On  The Form

'''''''''''''''''General Declaration'''''''''''''''''
Dim intSubfolderCount As Integer
Dim fsys As New Scripting.FileSystemObject
''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command1_Click()

    intSubfolderCount = 0
    Call scan("C:\BackUp") ' Path To Scan
    MsgBox intSubfolderCount

End Sub

Private Sub Form_Load()
   
    Command1.Caption="Scan"    

End Sub

Public Function scan(fname As String)

Dim fldFolder As Folder
Dim fldFolders As Folders
Dim fldSubFolders As Folder
Dim fileitem As File
Dim allfiles As Files

DoEvents

Set fldFolder = fsys.GetFolder(fname)
Set fldFolders = fldFolder.SubFolders
Set allfiles = fldFolder.Files
For Each fldSubFolders In fldFolders
    scan (fldSubFolders.Path)
    ' Increment The Counter
    intSubfolderCount = intSubfolderCount + 1
Next

End Function
0
 
LVL 20

Accepted Solution

by:
hes earned 50 total points
Comment Utility
Try using this:

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const MAX_PATH = 260
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Private Sub Form_Load()
MsgBox CountFolders("C:\")
End Sub
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function
Function CountFolders(Path As String)
Dim DirName As String ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(Path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = StripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                dirNames(nDir) = DirName
                DirCount = DirCount + 1
                nDir = nDir + 1
                ReDim Preserve dirNames(nDir)
            End If
        End If
        Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
        Loop
        Cont = FindClose(hSearch)
    End If
    CountFolders = DirCount - 1
End Function
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
Hi
I prefer to use collection instead of recursion:

'======Bas module code===
Option Explicit
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Type FOLDER_INFO
   DirSize As Currency
   FilesCount As Long
   DirsCount As Long
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public sFiles() As String

Public Function GetFolderInfo(sFolder As String) As FOLDER_INFO
   If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
   Dim lFileNum As Long, lDirNum As Long
   Dim curSize As Currency, FolderQueue As New Collection
   FolderQueue.Add sFolder
   Call EnumFolder(FolderQueue, lFileNum, curSize)
   FolderQueue.Remove 1
   Do While FolderQueue.Count > 0
      lDirNum = lDirNum + 1
      Call EnumFolder(FolderQueue, lFileNum, curSize)
      FolderQueue.Remove 1
      DoEvents
   Loop
   GetFolderInfo.DirSize = curSize
   GetFolderInfo.FilesCount = lFileNum
   GetFolderInfo.DirsCount = lDirNum
End Function

Private Sub EnumFolder(FolderQueue As Collection, lFileNum, lngSize As Currency)
   Dim sTemp As String, sFolder As String
   Dim lRet As Long, WFD As WIN32_FIND_DATA
   Dim hFile As Long, n As Integer
   sFolder = FolderQueue.Item(1)
   hFile = FindFirstFile(sFolder & "*.*", WFD)
   If hFile = INVALID_HANDLE_VALUE Then Exit Sub
   sTemp = TrimNulls(WFD.cFileName)
   Do While sTemp <> ""
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
         If sTemp <> "." And sTemp <> ".." Then
            If Right$(sTemp, 1) <> "\" Then sTemp = sTemp & "\"
            FolderQueue.Add sFolder & sTemp
         End If
      Else
         lngSize = lngSize + WFD.nFileSizeLow
         lFileNum = lFileNum + 1
         n = UBound(sFiles) + 1
         ReDim Preserve sFiles(n)
         sFiles(n) = sFolder & TrimNulls(WFD.cFileName)
      End If
      lRet = FindNextFile(hFile, WFD)
      sTemp = ""
      If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
   Loop
   lRet = FindClose(hFile)
End Sub

Private Function TrimNulls(sTemp As String) As String
   Dim l As Long
   l = InStr(1, sTemp, Chr(0))
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(sTemp, l - 1)
   Else
      TrimNulls = sTemp
   End If
End Function

'====Form code=======
Private Sub Command1_Click()
   ReDim sFiles(0)
   Dim l As FOLDER_INFO
   l = GetFolderInfo("c:\windows")
   MsgBox "Total  " & l.DirSize & " bytes" & " in " & l.FilesCount & " files at " & l.DirsCount & " Folders"
   For i = 0 To 10
       Debug.Print sFiles(i)
   Next i
End Sub

Cheers
0
 

Author Comment

by:MarcusAu
Comment Utility
Previously I was using the same method as you described. I even set the objects variable to nothing at the end of the function but it's still giving me Out of memory problem after some time except I used late binding instead of early binding. I couldn't use early binding because my program is sort of VB script. I couldn't include set the reference to Microsoft Scripting Runtime.
0
 

Author Comment

by:MarcusAu
Comment Utility
Ark,
My script cannot use collection object. Therefore, it won't work in my solution.
0
 

Author Comment

by:MarcusAu
Comment Utility
Hes,
Your solution is almost perfect to me but I have 3 questions pertaining to your solution.

(1)What is the value for the constant INVALID_HANDLE_VALUE ? Is it -1?

(2)What is the difference function between variable ndir and DirCount? I don't see any differences.

(3)Why you deduct one from DirCount at the end of the function? CountFolders = DirCount - 1. Shouldn't it be more accurate not to deduct one. I tested your function and if I follow exactly your coding, I won't get the correct folder count unless I remove the operation of minus 1 from DirCount.

(4)I put C:\ as my Path value of the input  parameter to your function CountFolders. I noticed the output includes 2 additional values, namely hiberfil.sys and pagefile.sys which are not really folder type.They are system file type.
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
OK, made it recursive (no collections):

'========Bas module code=====
Option Explicit
Const MAX_PATH = 260
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Type FOLDER_INFO
  DirSize As Currency
  FilesCount As Long
  DirsCount As Long
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public sFiles() As String

Public Function GetFolderInfo(sFolder As String) As FOLDER_INFO
  If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
  Dim lFileNum As Long, lDirNum As Long
  Dim curSize As Currency
  Call EnumFolder(sFolder, lDirNum, lFileNum, curSize)
  GetFolderInfo.DirSize = curSize
  GetFolderInfo.FilesCount = lFileNum
  GetFolderInfo.DirsCount = lDirNum
End Function

Private Sub EnumFolder(sFolder As String, lDirNum As Long, lFileNum, curSize As Currency)
  Dim sTemp As String
  Dim lRet As Long, WFD As WIN32_FIND_DATA
  Dim hFile As Long, n As Integer
  hFile = FindFirstFile(sFolder & "*.*", WFD)
  If hFile = INVALID_HANDLE_VALUE Then Exit Sub
  sTemp = TrimNulls(WFD.cFileName)
  Do While sTemp <> ""
     If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
        If sTemp <> "." And sTemp <> ".." Then
           If Right$(sTemp, 1) <> "\" Then sTemp = sTemp & "\"
           lDirNum = lDirNum + 1
           Call EnumFolder(sFolder & sTemp, lDirNum, lFileNum, curSize)
        End If
     Else
        curSize = curSize + WFD.nFileSizeLow
        lFileNum = lFileNum + 1
        n = UBound(sFiles) + 1
        ReDim Preserve sFiles(n)
        sFiles(n) = sFolder & TrimNulls(WFD.cFileName)
     End If
     lRet = FindNextFile(hFile, WFD)
     sTemp = ""
     If lRet <> 0 Then sTemp = TrimNulls(WFD.cFileName)
  Loop
  lRet = FindClose(hFile)
End Sub

Private Function TrimNulls(sTemp As String) As String
  Dim l As Long
  l = InStr(1, sTemp, Chr(0))
  If l = 1 Then
     TrimNulls = ""
  ElseIf l > 0 Then
     TrimNulls = Left$(sTemp, l - 1)
  Else
     TrimNulls = sTemp
  End If
End Function

'=======Form code===

Private Sub Command1_Click()
  ReDim sFiles(0)
  Dim l As FOLDER_INFO
  l = GetFolderInfo("d:\winapi")
  MsgBox "Total  " & l.DirSize & " bytes" & " in " & l.FilesCount & " files at " & l.DirsCount & " Folders "
  For i = 0 To 10
      Debug.Print sFiles(i)
  Next i
End Sub

0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
Oops, sorry, seems you don't need recursion, since hes solution suit your needs while it count only files in a root folder, not in subfolders.

Cheers
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Comment

by:MarcusAu
Comment Utility
Hes,
Your solution is almost perfect to me but I have 3 questions pertaining to your solution.

(1)What is the value for the constant INVALID_HANDLE_VALUE ? Is it -1?

(2)What is the difference function between variable ndir and DirCount? I don't see any differences.

(3)Why you deduct one from DirCount at the end of the function? CountFolders = DirCount - 1. Shouldn't it be more accurate not to deduct one. I tested your function and if I follow exactly your coding, I won't get the correct folder count unless I remove the operation of minus 1 from DirCount.

(4)I put C:\ as my Path value of the input  parameter to your function CountFolders. I noticed the output includes 2 additional values, namely hiberfil.sys and pagefile.sys which are not really folder type.They are system file type.
0
 
LVL 20

Expert Comment

by:hes
Comment Utility
Whoops forgot to paste that one :)

1)Const INVALID_HANDLE_VALUE = -1
2) You can get rid of DirCount and just use nDir
3) I had that in my example because it kept accepting Recycled as a dir (returned attribute &H16) any other folder use the count nDir
4) Check what the attribute is being returned from
GetFileAttributes(Path & DirName) when it gets to those files
0
 
LVL 20

Expert Comment

by:hes
Comment Utility
Here are the values returned for attributes

Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DEVICE = &H00000040
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ENCRYPTED = &H00004000
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H00002000
Private Const FILE_ATTRIBUTE_OFFLINE = &H00001000
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_REPARSE_POINT = &H00000400
Private Const FILE_ATTRIBUTE_SPARSE_FILE = &H00000200
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
0
 
LVL 20

Expert Comment

by:hes
Comment Utility
Ok change the line

If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then

To

If GetFileAttributes(Path & DirName) = FILE_ATTRIBUTE_DIRECTORY Then
               
               
0
 
LVL 20

Expert Comment

by:hes
Comment Utility
Another way
Dim GFA as long

Change

If (DirName <> ".") And (DirName <> "..") Then
           ' Check for directory with bitwise comparison.
           If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
               dirNames(nDir) = DirName
               DirCount = DirCount + 1
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
           End If
       End If
       

TO

If (DirName <> ".") And (DirName <> "..") Then
GFA = GetFileAttributes(Path & DirName)
              Select Case GFA
                Case 16, 17, 18, 36
                 dirNames(nDir) = DirName
                 'DirCount = DirCount + 1
                 nDir = nDir + 1
                 ReDim Preserve dirNames(nDir)
                 
              End Select

End If
0
 

Author Comment

by:MarcusAu
Comment Utility
Hes,
What are these values 16,17,18 and 36?
0
 
LVL 1

Expert Comment

by:Moondancer
Comment Utility
ADMINISTRATION WILL BE CONTACTING YOU SHORTLY.  Moderators Computer101, Netminder or Mindphaser will return to finalize these if they are still open in 7 days.  Experts, please post closing recommendations before that time.

Below are your open questions as of today.  Questions which have been inactive for 21 days or longer are considered to be abandoned and for those, your options are:
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you, but may help others. You must tell the participants why you wish to do this, and allow for Expert response.  This choice will include a refund to you, and will move this question to our PAQ (Previously Asked Question) database.  If you found information outside this question thread, please add it.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question (if it has no potential value for others).
   --> Post comments for expert of your intention to delete and why
   --> YOU CANNOT DELETE A QUESTION with comments; special handling by a Moderator is required.

For special handling needs, please post a zero point question in the link below and include the URL (question QID/link) that it regards with details.
http://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
Please click this link for Help Desk, Guidelines/Member Agreement and the Question/Answer process.  http://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Click you Member Profile to view your question history and please keep them updated. If you are a KnowledgePro user, use the Power Search option to find them.  

Questions which are LOCKED with a Proposed Answer but do not help you, should be rejected with comments added.  When you grade the question less than an A, please comment as to why.  This helps all involved, as well as others who may access this item in the future.  PLEASE DO NOT AWARD POINTS TO ME.

To view your open questions, please click the following link(s) and keep them all current with updates.
http://www.experts-exchange.com/questions/Q.20099164.html
http://www.experts-exchange.com/questions/Q.20100105.html
http://www.experts-exchange.com/questions/Q.20129810.html
http://www.experts-exchange.com/questions/Q.20174336.html
http://www.experts-exchange.com/questions/Q.20285962.html



*****  E X P E R T S    P L E A S E  ******  Leave your closing recommendations.
If you are interested in the cleanup effort, please click this link
http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20274643
POINTS FOR EXPERTS awaiting comments are listed in the link below
http://www.experts-exchange.com/commspt/Q.20277028.html
 
Moderators will finalize this question if in @7 days Asker has not responded.  This will be moved to the PAQ (Previously Asked Questions) at zero points, deleted or awarded.
 
Thanks everyone.
Moondancer
Moderator @ Experts Exchange
0
 
LVL 6

Expert Comment

by:Mindphaser
Comment Utility
Force accepted

** Mindphaser - Community Support Moderator **
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now