[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now


explore directory using fso

Posted on 2001-07-30
Medium Priority
Last Modified: 2012-08-14
Hi All,
By selecting one directory and clicking start button I need to be able to read the names of all the folders in the directory tree recursive without any more interruption with user. File System Object must be used. Code example would be greatly appreciated.

Question by:andr
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
LVL 70

Expert Comment

by:Éric Moreau
ID: 6334820
Something like this:

Private Sub GetPortefeuilles(ByVal pstrModele As String)
Dim intPos As Integer
Dim objFile As File
Dim objFolderChild As Folder
Dim objFolderSource As Folder
Dim objFSO As FileSystemObject
    Set objFSO = New FileSystemObject
    strPath = objFSO.GetFile(gstrFileName).ParentFolder.ParentFolder.Path
    Set objFolderSource = objFSO.GetFolder(strPath & strSubFolder)
    For Each objFolderChild In objFolderSource.SubFolders
        'Boucle pour ramasser tous les fichiers portefeuilles
        For Each objFile In objFolderChild.Files
                    If objFile.Name Like "*.csv" Then
                        msgbox objFile.Path & objFile.Name
                    End If
        Next objFile
    Next objFolderChild
End Sub
LVL 43

Expert Comment

ID: 6334861
andr here is an example, this is a little over the top perhaps but it returns all files and folders from a specified starting point, this can be chosen in a number of ways.

Private Sub Command1_Click()
    Dim colFiles As New Collection
    Set colFiles = GetFileList("UPF\Personal", "*.*", , True)
    MsgBox colFiles.Count
End Sub

Public Function GetFileList(strFolderPath As String, Optional strExtension As String = "*.*", Optional enuAttributes As FileAttribute = 0, Optional ByVal blnSearchSubFolders As Boolean = False, Optional ByRef colExisting As Collection) As Collection
    'Make sure a reference has been set to Microsoft Scripting Runtime
    'scrrun.dll before attempting to compile this code.
    '(c) TechRepublic, 2001 all rights reserved
    'The Windows Script Host Model must also be installed and registered to use the profile specific
    'switches in the folderpath argument: WSHOM.OCX
    'The folder path parameter may be one of the following:
    '1) A complete folder path either in Drive:\Folder\subfolder or in UNC e.g, \\ServerName\ShareName\Folder\SubFolder
    '2) A special folder
    '   a) WindowsFolder            :WindowsFolder
    '   b) Windows System Folder    :SystemFolder
    '   c) Temporary Files Folder   :TempFolder
    '3) A profile specific path to a system folder this is identified by prefixing with "UPF\" and may be one of the following
    '   a) Administrative Tools
    '   b) AppData
    '   c) Cache
    '   d) Cookies
    '   e) Desktop
    '   f) Favourites
    '   g) History
    '   h) Local AppData
    '   i) My Pictures
    '   j) NetHood
    '   k) Personal AKA My Documents
    '   l) PrintHood
    '   m) Programs
    '   n) Recent
    '   p) SendTo
    '   q) Start Menu
    '   r) Startup
    '   There may be additional options under Windows 9x, Windows 2000 or Windows XP.
    'The extension parameter may be specified either as "txt" to return all files matching this extension
    'or with a wildcarded filename, the wildcard characters "*" and "?" may be used both in the
    'filename and extension parts, following the standard windows rules for these things
    'The blnSearchSubFolders parameter may be used to search only the specified folder (False) or all subfolders (True)
    'The colExisting parameter may be passed an existing collection, this can be used to create a collection first
    'and then run consecutive searches on different criteria and return the result in one collection
    'this is effectively what is achieved by the recursion into this routine when searching
    'all subfolders from the given starting point.
    Dim fs As Scripting.FileSystemObject
    Dim fldr As Scripting.Folder
    Dim subfldr As Scripting.Folder
    Dim f As Scripting.File
    Dim strProfileRoot As String
    'Get the user's special folder root reference
    strProfileRoot = Environ("UserProfile")
    'Get reference to file system
    Set fs = New FileSystemObject
    'Check for a special folder
    Select Case UCase(strFolderPath)
        strFolderPath = fs.GetSpecialFolder(0)
        strFolderPath = fs.GetSpecialFolder(1)
        strFolderPath = fs.GetSpecialFolder(2)
    End Select
    'Check for a profile specific folder
    If Left$(UCase(strFolderPath), 4) = "UPF\" Then
        'Get rid of the UPF\ part
        strFolderPath = Right$(strFolderPath, Len(strFolderPath) - 4)
        'Get the real location of this folder from the registry
        strFolderPath = strProfileRoot & GetActualPathFromRegistry(strFolderPath)
    End If
    'Check that the folder exists
    If fs.FolderExists(strFolderPath) Then
        'Create a new collection to store the
        'file objects in
        If colExisting Is Nothing Then
            Set GetFileList = New Collection
            Set GetFileList = colExisting
        End If
        'Get a pointer to the folder
        Set fldr = fs.GetFolder(strFolderPath)
        'Should we search this folder only or include sub folders
        If blnSearchSubFolders Then
            For Each subfldr In fldr.SubFolders
                GetFileList subfldr.Path, strExtension, enuAttributes, blnSearchSubFolders, GetFileList
        End If
        For Each f In fldr.Files
            blAddToList = True
            'Build a list of files matching the extension
            'we received
            If InStrRev(strExtension, ".") > 0 Then
                'Match a wildcard filename
                blAddToList = f.Name Like strExtension
                blAddToList = f.Name Like "*." & strExtension
            End If
            If enuAttributes <> 0 And blAddToList Then
                'Check the file attributes by doing a bitwise and
                'on the attributes property for the specified
                'lngAttributes. If none of the bit(s) we are
                'looking for are set then don't add the file
                If (f.Attributes And enuAttributes) = 0 Then
                    blAddToList = False
                End If
            End If
            If blAddToList Then
                'Add the file to the collection
                GetFileList.Add f, f.Path & " : " & f.Name
            End If
            'Go to the next file in the folder
        Next f
        MsgBox strFolderPath & " does not exist"
    End If
    'Clean up by destroying the reference to the FileSystemObject
    Set fs = Nothing
End Function

Public Function GetActualPathFromRegistry(ByVal FolderName As String) As String
    'Declare the object
    Dim wshShell As Object
    Dim strPath As String
    'Create the Windows Scripting Host Shell object
    Set wshShell = CreateObject("WScript.Shell")
    On Error GoTo errBadRead
    'Read the registry for the appropriate value
    strPath = wshShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\" & FolderName)
    'trim it up if necessary, remove %USERPROFILE% value from NT, not required on 2000
    strPath = Right$(strPath, Len(strPath) - (InStr(strPath, "\") - 1))
    'Return the value we found
    GetActualPathFromRegistry = strPath
    'Clean up the object
    Set wshShell = Nothing
    Exit Function
    'Couldn't find the registry key so return unavailable and clean up
    GetActualPathFromRegistry = "Unavailable"
    Set wshShell = Nothing
End Function

Author Comment

ID: 6335024
this is only searching subfolders in the passed folder. I need to loop thru all the subfolders in each subfolder... until the very last subfolder in the tree
LVL 70

Accepted Solution

Éric Moreau earned 400 total points
ID: 6335261

This is better:

Private Sub Command1_Click()
    Call ScanFolder("D:\emoreau\download")
End Sub

Private Sub ScanFolder(ByVal pstrPath As String)
Dim objFile As File
Dim objFolderChild As Folder
Dim objFolderSource As Folder
Dim objFSO As FileSystemObject

    Set objFSO = New FileSystemObject
    Set objFolderSource = objFSO.GetFolder(pstrPath)

    For Each objFolderChild In objFolderSource.SubFolders
        Call ScanFolder(objFolderChild.Path)
        For Each objFile In objFolderChild.Files
            List1.AddItem objFolderChild.Path & "\" & objFile.Name
       Next objFile
    Next objFolderChild
End Sub


Author Comment

ID: 6335415
Thanks emoreau, that works great.

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

650 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