0

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 1 enter image description here

Pic 2

enter image description here

Pic 3

enter image description here

Pic 4

enter image description here

Pic 5

enter image description here

Community
  • 1
  • 1
Philip Connell
  • 651
  • 5
  • 25
  • 53
  • Possible duplicate of [VBA Loop through folder and subfolders to find specific sheet then Copy and Paste certain data](http://stackoverflow.com/questions/43318867/vba-loop-through-folder-and-subfolders-to-find-specific-sheet-then-copy-and-past) – Luuklag Apr 26 '17 at 08:33
  • 1
    Hi Luuklag: The link you have supplied is indeed my question. I did accept an answer there and the solution worked. Then the folders evolved and I struggled to amend the code I had received to accommodate more folders . I am relatively new with the site 196 points and i figured creating a new question would get better results than revisiting an old. I hope I have not infringed on the ethics of the site as it has been very good to me thus far. – Philip Connell Apr 26 '17 at 09:24
  • 1
    Looks like you just need to add a second level of childfolders – Luuklag Apr 26 '17 at 09:33
  • 1
    If your problem is to do with recursively looking through child subfolders, you might find my [answer to a related question](http://stackoverflow.com/a/43517300/7648526) helpful. – SteveES Apr 26 '17 at 09:47
  • 1
    http://stackoverflow.com/questions/41102975/how-can-i-improve-my-function-for-handling-alternative-to-application-filesearch take your time to read through this. – mojo3340 Apr 26 '17 at 10:21

0 Answers0