(Solved) – Looping through all excel files in a folder to extract data – showing error: file missing

(solved)-–-looping-through-all-excel-files-in-a-folder-to-extract-data-–-showing-error:-file-missing

I have a set of some ~550 excel files that I need to extract data out of into a master sheet. The files are in the same main directory, grouped in 17 sub-folders. All the files are labelled with the same format eg LT-A01-001. I have set up a macro to loop through the 17 subfolders and all excel files in those sub folders and copy a few sets of values to the master sheet.

At the moment when I run the macro it comes back with “Error 1004: we couldn’t find LT-A01-001.xlsx”. Any idea what I’ve missed?

'Sub ExtractLTdata()

    Dim designfile As String, x As Integer, wbmstr As Workbook, wbiso As Workbook, mstrsheet As Worksheet, starttime As Double, secondsrun As Double

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    starttime = Timer

    'create new sheet for each extract with current date & time using template sheet
    Sheets("TEMPLATE_data").Select
    Sheets("TEMPLATE_data").Copy After:=Sheets(2)
    ActiveSheet.Name = WorksheetFunction.Text(Now(), "d-mmm-yyyy hmm am/pm")
    Set wbmstr = ThisWorkbook
    Set mstrsheet = ActiveSheet

    'loop for area folders
    For x = 1 To 17

        'loop through all .xlsx in folder
        designfile = Dir("C:UserscadialgDocumentsCBLTArea " & x & "*.xlsx")

        Do While designfile <> ""

            Set wbiso = Workbooks.Open(filename:=designfile)

            DoEvents

                'copy & paste design load data
                wbiso.Worksheets("0.SUMMARY").Range("D21:D27").Copy

                wbmstr.mstrsheet.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Transpose:=True

                'copy & paste foundation geometry data
                wbiso.Worksheets("0.SUMMARY").Range("D32:D44").Copy

                wbmstr.mstrsheet.Range("A1").End(xlDown).Offset(0, 7).PasteSpecial Transpose:=True

                'copy & paste no. of bars req
                wbiso.Worksheets("2.THICKENING").Range("E43:E44").Copy

                wbmstr.mstrsheet.Range("A1").End(xlDown).Offset(0, 20).PasteSpecial Transpose:=True

            wbiso.Close SaveChanges:=False

            DoEvents

            'next file
            filename = Dir
        Loop
    Next

    secondsrun = Round(Timer - starttime, 2)

    MsgBox "This code ran successfully in " & secondsrun & " seconds", vbInformation

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *