Excel: VBA: 2013 Loop through folders

[BIGTONE559]

I need help looping through folders/sub folders and counting file types ".xlsx".

Please help!

 

[circledchicken]

Hi,

Given you are using Excel 2013, I think the easiest way is using the Data Explorer add-in:
https://www.microsoft.com/en-gb/download/details.aspx?id=36803

Its very intuitive. After selecting From File -> From Folder, there's just 4 quick steps:

• Select the source folder
• Hide all columns except the Extension column
• Filter the Extension column for '.xlsx'
• Choose 'Group By...', and choose the 'Count Rows' operation

That's it! You should now have fully refreshable output with a count of '.xlsx' files.

Data Explorer looks like it will be an extremely useful tool. Here are some more links for further reading if you are interested:

• https://thedataspecialist.wordpress.com/2013/03/05/microsoft-data-explorera-review/
• 5 Cool Things You Can Do With Data Explorer » Bacon Bits:
• https://cwebbbi.wordpress.com/2013/03/15/finding-shakespeares-favourite-words-with-data-explorer/

 

[BIGTONE559]

In the short term this provides me a solution however i'd like to work with the data directly and not have to rely on the query excel generates for this data. I appreciate the the info i did download the data explorer and this should provide a good tool for me to check against.. . .

in all actuality it works great. . . just curious of how to perform this operation on the back end.

 

[circledchicken]

I'm not sure what you mean by 'how to perform this operation on the back end' ?

 

[rjwebgraphix]

This is an interesting function I ran across last month that could pertain to what you want to do.

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
' Variation of http://allenbrowne.com/ser-59.html

    Dim colDirList As New Collection
    Dim varItem As Variant
    Dim FileList() As Variant
    Dim FileCnt As Long
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
    'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
    If lst Is Nothing Then
        FileCnt = 0
        For Each varItem In colDirList
            ReDim Preserve FileList(FileCnt)
            FileList(FileCnt) = varItem
            FileCnt = FileCnt + 1
        Next
    Else
        For Each varItem In colDirList
        lst.AddItem varItem
        Next
    End If
    
    ListFiles = FileList
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & err.Number & ": " & err.Description
    Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    bIncludeSubfolders As Boolean)
    'Build up a list of files, and then add add to this list, any additional folders
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

It's usage is something like this.

dim myfiles as variant
'FolderName is the folder you want to search through.
'FileType can be *.*, *.xls, *.xls?, what ever you're looking for.
'True is a boolean true/false to include sub directories.
MyFiles = ListFiles(FolderName, FileType, True)

Now that you have all the filenames in an array, you can check their extensions or do what you want with them.

 

[Garry2Rs]

Here's what I use for listing files of specific types...

Sub ListFiles()
' Lists files of user-selected type, located in user-selected folder
  Dim sFileType$, sPath$, sMsg$, lNextRow&
  Dim fDlg, fType, f, bReturn As Boolean
  
  'Get the folder
  If Application.VERSION > 9 Then
    Set fDlg = Application.FileDialog(4)
    With fDlg
      If .Show = False Then Exit Sub      'User cancelled
      sPath = .SelectedItems(1)
    End With
  Else
    sPath = GetDirectory(mszPickFolder)
  End If
  If sPath = "" Then Exit Sub      'User cancelled
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  
  'Instructional info for user filetype input
  sMsg = "Enter the file type extension." & vbCrLf
  sMsg = sMsg & "Example:  xls" & vbCrLf
  sMsg = sMsg & "(Not case sensitive)" & vbCrLf & vbCrLf
  sMsg = sMsg & "Separate types with a comma. (no spaces) ie.  xls,pdf,txt,etc " & vbCrLf & vbCrLf
  sMsg = sMsg & "For types having no extension, enter a minus (-) sign."
  
  'Prompt for user input
  sFileType = InputBox(sMsg)
  If sFileType = "" Then Beep: Exit Sub      'If user cancels
  lNextRow = InputBox("What row do you want to start in?")
  
  Application.ScreenUpdating = False
  On Error GoTo Cleanup
  f = Dir(sPath, 7)
  Do While f <> ""
    'Filter for filetype
    For Each fType In Split(sFileType, ",", , vbTextCompare)
      Cells(lNextRow, 1) = f: Application.StatusBar = "Processing File:  " & f
      lNextRow = lNextRow + 1
    Next fType
    f = Dir 'Get next file
  Loop 'While f <> ""
  
Cleanup:
  With Application
    .StatusBar = False: .ScreenUpdating = True
  End With
End Sub 'ListFiles

..where you'll be prompted to select the folder to search, then you'll be prompted to provide the file extensions you want to filter on, then you'll be prompted for the row number (in col A) where you want to start the list.

HTH