So my question has been marked as a possible Duplicate of VBA Loop through folder and subfolders to find specific sheet then Copy and Paste certain data
This is indeed my question and it is practically the same. The part I am struggling with is getting automation from the first folder through to the rest I think the piece of code that is relevant for change is here
For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
myFile = Dir(MyFolder & ChildFolder.Name & "\") 'DIR gets the first file of the folder
I have no desire to upset the ethics of the site. I simply accepted an answer and struggled with the code I had after changes happened in the workplace.
Original Question Below
I hope you can help. I have a piece of code and its works fine. Essentially it allows a user to click on a command button (see Pic 5) on an Excel Workbook opens a dialog box allows the user to select a folder then once the folder is selected the code loops through the folder for files named Like "CustomerExp" then copies and pastes information on this Like "CustomerExp" Excel sheet to another Excel sheet called rejects in the Workbook where the Command Button is held. The only issue I have is that it still requires some manual input from the user.
The issue I am facing is this: I have a folder 2017 it is stored here X:\Operations\Rejections all Markets see Pic 1
Within folder 2017 I have more folders named for months of the year. See Pic 2
Within each monthly folder lets take Jan for example there will be several more folders see Pic 3
Withing each folder inside the monthly folder there are excel sheets saved see Pic 4
As i said my code does actually work but what the user has to do is select a monthly folder each time. So the user clicks the command button navigates to Jan folder double clicks on Jan folder and the code works. Then the user has to double click on Feb folder and the code works again and then onto March.
What I want is for the user to click only on folder 2017 and the code will then go through Jan and all its folders find files named Like "CustomerExp" do the copy and paste then move onto Feb and then March and so forth without any input or double clicking on each monthly folder by the user. I'm looking for full automation from the click on the 2017 folder.
My code is below can it be amended to provide full automation from the 2017 folder. As always any and all help is greatly appreciated.
MY CODE
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim myFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
Dim FSO As New FileSystemObject ' Requires "Windows Script Host Object Model" in Tools -> References
Dim ParentFolder As Object, ChildFolder As Object
Dim wb As Workbook
Dim myPath As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
myFile = Dir(MyFolder) 'DIR gets the first file of the folder
Set y = ThisWorkbook
Set ws2 = y.Sheets("Rejects")
'Loop through all files in a folder until DIR cannot find anymore
Do While myFile <> ""
If myFile Like "*CustomerExp*" Then
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & myFile)
'Replace the line below with the statements you would want your macro to perform
With wbk.Sheets(1)
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:AA" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
End With
''Application.Wait (Now + TimeValue("0:00:05"))
wbk.Close savechanges:=True
End If
myFile = Dir 'DIR gets the next file in the folder
Loop
For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
myFile = Dir(MyFolder & ChildFolder.Name & "\") 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While myFile <> ""
If myFile Like "*CustomerExp*" Then
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & ChildFolder.Name & "\" & myFile)
'Replace the line below with the statements you would want your macro to perform
With wbk.Sheets(1)
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:AA" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
End With
''Application.Wait (Now + TimeValue("0:00:05"))
wbk.Close savechanges:=True
End If
myFile = Dir 'DIR gets the next file in the folder
Loop
Next ChildFolder
Application.ScreenUpdating = True
End Sub
Pic 2
Pic 3
Pic 4
Pic 5