Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 27

Thread: Button to Search Subfolders for files

  1. #1
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location

    Button to Search Subfolders for files

    Hi team,

    I have the following code which successfully populates a worksheet with any excel files where the file name starts with the project number "9876".

    This is the code:

    Private Sub btnPopulate_Click()Dim sPath As String, fileName As String, i As Integer
    
    
        Application.ScreenUpdating = False
    
    
        sPath = "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
    
    
        fileName = Dir(sPath & "9876*.xl??")
    
    
    Do While fileName <> ""
    i = i + 1
    Cells(i, 1) = fileName
    fileName = Dir()
    Loop
    
    
        Application.ScreenUpdating = True
    
    
    End Sub
    How can I make it search all the sub-folders within the specified sub-directory's of sPath?

    Cheers,

    Luke Kelsen

  2. #2
    VBAX Regular Sixthsense..'s Avatar
    Joined
    Dec 2012
    Location
    India
    Posts
    15
    Location
    Try this untested code

    Option Explicit
    Private Sub btnPopulate_Click()
    Dim sPath As String, fileName As String, i As Integer, x As Byte, sExt As String
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
    
    sPath = "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(sPath)
    
    Application.ScreenUpdating = False
    
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        
        For Each oFile In oFolder.Files
            sExt = Right$(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, "."))
            x = InStr(sExt, "xl")
            If x Then
                If Left(oFile.Name, 4) = "9876" Then
                    i = i + 1
                    Cells(i, 1) = fileName
                End If
            End If
        Next oFile
    Loop
         
    Application.ScreenUpdating = True
        
    End Sub

  3. #3
    snb
    Guest
    2 lines suffice:

    Sub M_snb()
       sn=split(createobject("wscript.shell").exec("cmd /c Dir ""I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\9876*.xl??"" /b/s").stdout.readall,vbcrlf)
       sheet1.cells(1).resize(ubound(sn))=application.transpose(sn)
    end sub
    NB. You'd better avoid using spaces in foldernames.

  4. #4
    Here is my code.

    Untested

    Option Explicit
    
    
    Private Sub btnPopulate_Click()
        
        Dim fso As Object
        Dim oFolder As Object
        Dim sPath As String
        Dim sFiles(1 To 1048576) As String
        Dim i As Long
         
        Application.ScreenUpdating = False
        
        sPath = "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set oFolder = fso.GetFolder(sPath)
        
        ' Call the recursive function
        Call GetFiles(oFolder, "9876*.xl??", sFiles, i, True)
        
        ' Copy the data to the range at the end.
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(i).Value = sFiles
        
        Application.ScreenUpdating = True
         
    End Sub
    
    
    Private Sub GetFiles(ByVal oFolder As Object, _
                         ByVal strCriteria As String, _
                         ByRef arrFiles() As String, _
                         ByRef i As Long, _
                         Optional ByVal bIncludeSubFolders As Boolean = True)
    
    
        Dim oFile As Object
        Dim oSubFolder As Object
    
    
        ' Get all the files
        For Each oFile In oFolder.Files
            If oFile.Name Like strCriteria Then
                arrFiles(i) = oFile.Name
                i = i + 1
            End If
        Next
    
    
        ' If you want to grab the infromation from all subfoders then
        ' gro through the subfolders and call the function recursivly
        If bIncludeSubFolders Then
            For Each oSubFolder In oFolder.SubFolders
                Call GetFiles(oSubFolder, strCriteria, arrFiles, i, bIncludeSubFolders)
            Next
        End If
    
    
    End Sub
    Feedback is the best way for me to learn


    Follow the Armies

  5. #5
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    Thank you all three of you for your replies.

    snb your 2 lines of code work like a charm! Just out of curiosity, why do you advise to avoid using spaces in foldernames?

    Cheers again for your help,

    Luke

  6. #6
    snb
    Guest
    If foldernames do not contain spaces the code can do without the often as complicated considered quotation marks.

    Instead of
    sn=split(createobject("wscript.shell").exec("cmd /c Dir ""I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\9876*.xl??"" /b/s").stdout.readall,vbcrlf)

    you can use

    sn=split(createobject("wscript.shell").exec("cmd /c Dir I:\02_Clients\Test_Client\Projects\9876_-_Core_Group_Test_Project\9876*.xl?? /b/s").stdout.readall,vbcrlf)

  7. #7
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    I see, unfortunately our hundreds of already existing projects already contain spaces and this is the preference for the way the company I work for, names their folders.

    This maybe something relative, I want to place a declared string in the first line which would replace the directory. So I would have the following:

    Sub M_snb() Dim sn As Variant
    Dim sPath As String 'This is the declared string name
    
    sPath = ActiveWorkbook.Path & "\"
        
        sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir sPath ""9876*.xl??"" /b/s").StdOut.ReadAll, vbCrLf) 'sPath replaces the directory in question
        Sheet1.Cells(1).Resize(UBound(sn)) = Application.Transpose(sn) 'I get the run-time error type 13 on this line of code
    
    End Sub
    I get a run-time error 13 type mismatch when i execute. The reason I need the sPath string here is because this workbook will exist in every project folder we create so the directory path is always going to change.

    Cheers,

    Luke
    Last edited by lkelsen; 06-04-2015 at 02:30 PM.

  8. #8
    snb
    Guest
    That's exactly illustrating the problem with spaces containing foldernames

    Sub M_snb() 
        c00="I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
    
        sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "9876*.xl??"" /b/s").stdout.readall,vbcrlf) 
        sheet1.cells(1).resize(ubound(sn))=application.transpose(sn) 
    End Sub

  9. #9
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    Yup I thought so, but your code has once again solved my problem and I thank you for this snb!

    Much appreciated once again

    Luke

  10. #10
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    snb, Sorry to drag out this solved thread but how would I use this code so that it only populates my spreadsheet with only the excel filename not the directory string before it and also ignore the .xls file exstension?

    I could use a formula in the actual spreadsheet itself but this will create a whole lot of unnecessary code..
    Last edited by lkelsen; 06-04-2015 at 04:20 PM.

  11. #11
    snb
    Guest
    in that case you do not want to look in subfolders : /s can be omitted
    the replacement of the fileextension can be done by replace( .. , .. ), or somewhat slickier (see below)

    Sub M_snb() 
        c00="I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\" 
         
        sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "9876*.xl??"" /b").stdout.readall,".xls" & vbcrlf) 
        sheet1.cells(1).resize(ubound(sn))=application.transpose(sn) 
    End Sub

  12. #12
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    Sorry for the late reply been on other jobs.

    No I still want the spreadsheet to list every single excel within the specified folder and subfolders but I just dont want the full path to be listed.
    For example If it pulls a sheet from I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\8 - Purchasing\9876-EST-001 - Rev 0 - Luke.xlsx

    Then say in Cell A1 all I want it to say is "9876-EST-001 - Rev 0 - Luke" (The name of the excel file).

    Whether that is possible or not? Never mind if not I can just use a formula in the spreadsheet itself.

    Cheers,

    Luke

  13. #13
    snb
    Guest
    Sub M_snb() 
        c00="I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\" 
         
        sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "9876*.xl??"" /b").stdout.readall,".xls" & vbcrlf) 
        for j=0 to ubound(sn)
          sn(j)=dir(sn(j))
        next
        sheet1.cells(1).resize(ubound(sn))=application.transpose(sn) 
    End Sub

  14. #14
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,645
    how about GetBaseName method of FileSystemObject?

    Sub M_snb()
        
        c00 = "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\"
        sn = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & c00 & "9876*.xl??"" /b").StdOut.ReadAll, vbCrLf)
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        For j = 0 To UBound(sn)
            sn(j) = fso.GetBaseName(sn(j))
        Next
        
        Sheet1.Cells(1).Resize(UBound(sn)) = Application.Transpose(sn)
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  15. #15
    snb
    Guest
    Seems to me equally excellent

  16. #16
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,645
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  17. #17
    VBAX Regular
    Joined
    May 2015
    Location
    New Plymouth, New Zealand
    Posts
    38
    Location
    Never thought i'd get back here, been changed departments in the company.

    snb for some reason with your code i get a:

    "Run-time error '52':

    Bad file name or number"

    mancubus's alternative seems to work though, however i had to reintroduce the omitted /s to get all sub folder files. This now works brilliantly!

    Thanks very much to the both of you for your input and sorry for the late response.

    Cheers,


    Luke

  18. #18
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,645
    you are welcome.


    for RTE 52:
    do names of the files or folders contain, lets say, non-english characters?
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  19. #19
    snb
    Guest
    rather obvious:

    Sub M_snb() 
        c00="I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project\" 
        sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "9876*.xl??"" /b").stdout.readall,".xls" & vbcrlf) 
    
        For j=0 To ubound(sn) -1
            sn(j)=dir(sn(j)) 
        Next 
    
        sheet1.cells(1).resize(ubound(sn))=application.transpose(sn) 
    End Sub

  20. #20
    VBAX Regular
    Joined
    Jul 2013
    Posts
    56
    Location
    Late to the party.. but maybe this is an interesting alternative also..

    Private Sub CommandButton1_Click()
        fPath = """" & "I:\02 Clients\Test Client\Projects\9876 - Core Group Test Project" & """"
        Z = Split(CreateObject("wscript.shell").exec("cmd /c forfiles /P " & fPath & " /S /M  *.xl?? /c ""cmd /c echo  @file """).stdout.readall, vbCrLf)
        Sheets("Sheet1").Cells(1).Resize(UBound(Z)) = Application.Transpose(Z)
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •