Code path

[StellaArtois]

Hi all i have a code that searches data from a list of workbooks found in a folder

The data is copeied and pasted into a column i can utilise for reporting

this works well? But....

Is there a way to manipulate the filepath to look for workbooks within the main folder and any folders within the main folder

Sub Update_Backorders()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim rng As Range

   'myPath = "\\dta01\AftService\shops\Admin\Parts & Materials\Parts Lists WIP\Other\"
   myPath = "C:\Users\uknown\Desktop\WIP\Main\"

  myExtension = "*.xls"

  myFile = Dir(myPath & myExtension)


Set rng = ThisWorkbook.Sheets("Other").Range("C3")
x = 0

  Do While myFile <> ""
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
      
      wb.Worksheets(1).Range("ET16:FL512").Copy
      ThisWorkbook.Sheets("Other").Activate
      rng.Offset(x).PasteSpecial xlPasteValues
      Application.CutCopyMode = False
      Set Copiedrng = Selection
      
      For Each cell In Copiedrng.Columns(1).Cells
      yy = cell.Address
        If cell.Value = "" Then
          RowLength = cell.Row
          Exit For
        End If
      Next cell
    
      x = RowLength - rng.Row + 0
                   
      wb.Close SaveChanges:=False

      myFile = Dir
  Loop
  
    Range("A1").Select
    Sheets("Report").Select
    Range("A1").Select

    Call Calculation_Automatic

End Sub
[code/]

 

[Jeffrey Mahoney]

You need to look for Recursive Folder Excel VBA and you will find a ton of hits. Here's one:
VBA to List all Folders, Subfolders and files in a directory

 

[StellaArtois]

Hi Jeffrey,

Not entirely sure what i am looking at really, a little more assistance if i may please

Thanks for your help

 

[Jeffrey Mahoney]

Ok, so use these two subs to get all the subfolders under the main folder you want to search. Then use that entire list to go find the files you need

Call the GetAllSubFolderPaths with the Folder you want to start. It will get all the folder paths and store them in SubFolderPaths(). SubFolderCnt keeps the number of folders found.


Put this code in a standard module

Public SubFolderPaths() As String
Public SubFolderCnt As Long


Sub GetAllSubFolderPaths(FldrStart As String)

  ReDim SubFolderPaths(1 To 100000)
  Dim i As Long
  
  SubFolderCnt = 1
  SubFolderPaths(SubFolderCnt) = FldrStart

'Another Macro must call LoopAllSubFolders Macro to start to procedure
  Call LoopAllSubFolders(FldrStart)
  
  ReDim Preserve SubFolderPaths(1 To SubFolderCnt)
  
  'Comment this out after testing
  For i = 1 To SubFolderCnt
    Sheets("Sheet1").Range("A1").Offset(i, 0).Value = SubFolderPaths(i)
  Next i

End Sub



'List all files in sub folders
Sub LoopAllSubFolders(ByVal FolderPath As String)

  Dim Fldr As String
  Dim fullFilePath As String
  Dim CntBeg As Long
  Dim CntEnd As Long
  Dim i As Long
  
  If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
  Fldr = Dir(FolderPath & "*.*", vbDirectory)
  If Len(Fldr) <> 0 And Left(Fldr, 1) <> "." Then
    If (GetAttr(FolderPath & Fldr) And vbDirectory) = vbDirectory Then
      SubFolderCnt = SubFolderCnt + 1
      SubFolderPaths(SubFolderCnt) = FolderPath & Fldr
      CntBeg = SubFolderCnt
    End If
  End If

  While Len(Fldr) <> 0
    Fldr = Dir()
    
    If Left(Fldr, 1) <> "." And Len(Fldr) <> 0 Then
      If (GetAttr(FolderPath & Fldr) And vbDirectory) = vbDirectory Then
        SubFolderCnt = SubFolderCnt + 1
        SubFolderPaths(SubFolderCnt) = FolderPath & Fldr & "\"
        If CntBeg = 0 Then CntBeg = SubFolderCnt
        CntEnd = SubFolderCnt
      End If
    End If
 
  Wend
  If CntBeg > 0 Then
    For i = CntBeg To CntEnd
      LoopAllSubFolders SubFolderPaths(i)
    Next i
  End If

End Sub

 

[Jeffrey Mahoney]

So, are you wanting to open every *.xls file in all the subfolders? Or are you trying to find a specific file?

Sometimes I search for a filename that meets a certain certain criteria with the latest date. If you need help with that I have some code.

This code is a snipit of how you would use the code above to open all workbooks that fit the filename criteria.

myPath = "C:\Users\uknown\Desktop\WIP\Main\"
  
  '--------------------------
  GetAllSubFolderPaths myPath
  '--------------------------
  
  For X = 1 To SubFolderCnt
    myFile = Dir(SubFolderPaths(X) & "Finance 101*.xls")
    Do While myFile <> ""
      Set wb = Workbooks.Open(SubFolderPaths(X) & myFile)
      'do something with the file
      myFile = Dir
    Wend
  Next X

 

[StellaArtois]

Hi Jeffrey,

All folder workbooks within the main folder and sub folders is what i am looking for

Many thanks

 

[Jeffrey Mahoney]

Well the first set of code will give you that. Did you try it yet?

 

[StellaArtois]

Hi Jeffrey,

It doesnt show as a macro to run?

 

[Jeffrey Mahoney]

If you want to do a simple test to see if it works, add this SUB below. BE CAREFULL, the macro will overwrite any data you have on SHEET1. If you want to write the subfolders list on a different sheet, then change this line in the SUB "GetAllSubFolderPathswhere" it says Sheet1 to another new sheet name:
Sheets("Sheet1").Range("A1").Offset(i, 0).Value = SubFolderPaths(i)

Sub LoadAllSubFolders()
  Dim myPath As String

  myPath = "C:\Users\uknown\Desktop\WIP\Main\"
  
  '--------------------------
  GetAllSubFolderPaths myPath
  '--------------------------
End Sub

 

[StellaArtois]

Hi Jeffrey,

sorry add this sub where? im a bit lost here if im honest?

thanks tho