Code path

StellaArtois

New Member
Joined
Jan 10, 2024
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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

Code:
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/]
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi Jeffrey,

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

Thanks for your help
 
Upvote 0
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
VBA Code:
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
 
Upvote 0
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.
VBA Code:
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
 
Upvote 0
Hi Jeffrey,

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

Many thanks
 
Upvote 0
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)


VBA Code:
Sub LoadAllSubFolders()
  Dim myPath As String

  myPath = "C:\Users\uknown\Desktop\WIP\Main\"
  
  '--------------------------
  GetAllSubFolderPaths myPath
  '--------------------------
End Sub
 
Upvote 0
Hi Jeffrey,

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

thanks tho
 
Upvote 0

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top