Given a File Path. I am trying to import all the (xlsx) files that start with '001-'100 within that folder (So far I am able to import them with the following macro)
Sub Select_Folder() 'returns a list of files located in the indicated folder Dim directory As String Dim firstFile As String Dim dataFile As String ''Dim bottom As String Dim IB As String Dim diaFolder As FileDialog 'checks to see if Filter Mode is on. 'Prompts the user to turn off filter mode 'and aborts the function If Sheets("Master").FilterMode = True Then MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _ "The Filter on this sheet is still active." & vbNewLine & _ "Please turn off FilterMode off to continue. (Error: 002)", vbCritical + vbApplicationModal, "Microsoft Excel" End End If 'Turn Off Screen Updating and 'Event Handiling With Application .ScreenUpdating = False .EnableEvents = False End With Sheets("Master").Range("C4", Range("C4").End(xlDown)).EntireRow.Delete 'the directory is taken from the inputs on the spreadsheet Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker) With diaFolder .AllowMultiSelect = False .InitialFileName = "C:\Users\" On Error GoTo Err2: .Show directory = .SelectedItems(1) & "\" End With Set diaFolder = Nothing If Len(Dir(directory, vbDirectory)) = 0 Then MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _ "The directory " & directory & " Does not exist." & vbNewLine & _ "Please check to make sure that this directory exists. (Error: 005)", vbCritical + vbApplicationModal, "No Directory Exists" With Application .ScreenUpdating = True .EnableEvents = True End With End End If 'sets the first file in the folder 'if no first file exists, the program ends firstFile = Dir(directory) If firstFile = "" Then MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _ "There are no files in the directory: " & directory & vbNewLine & _ "Please check to make sure that there are files in this Directory. (Error: 006)", vbCritical + vbApplicationModal, "No Files Exist" With Application .ScreenUpdating = True .EnableEvents = True End With End End If 'places the first file in the first row Range("B4") = -1 Range("D4") = firstFile Range("C4") = Left(firstFile, Application.WorksheetFunction.Search(" ", firstFile) - 1) Range("D2") = directory 'finds the next files in the folder 'Looks at the first four characters in the file name 'if the first four characters returned. Do dataFile = Dir() If dataFile = "" Then Exit Do ElseIf Left(dataFile, 4) <> "Term" And Left(dataFile, 4) <> "Inac" Then Range("D4").Select 'finds the next blank cell in range "D5" ' Do Until ActiveCell.Value = "" Do Until ActiveCell.Text = "" ActiveCell.Offset(1, 0).Activate Loop ActiveCell.Value = dataFile IB = Left(dataFile, Application.WorksheetFunction.Search(" ", dataFile) - 1) ActiveCell.Offset(0, -1).Value = IB ActiveCell.Offset(0, -2).Value = -1 End If Loop 'finds the lowest cell in the range to set as the base 'fills two formulas to find the Name and Type of Report starting at E4 and F4 'Autofits Columns E and F Err2: Exit Sub End Sub
Now I want to be able to not only do it for that folder but also the folders inside (Sub Folders).
I tried implementing
Sub DoFolderFolder_backup() Dim SubFolder For Each SubFolder In Folder.SubFolders DoFolder SubFolder Next Dim File For Each File In Folder.Files ' Operate on each file Call Select_Folder Next
Please help me.
The format of the "Master sheet" is the following