Open All File in All Folder Path Then Skip to Empty Folder-CodePudding

I need to open file in each folder copy and paste but the code stop for next loop.

The code I refer to this https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/

Here code have been tried (code stop at next i)

Option Explicit

Sub LoopAllFilesInFolder()

Dim folderName As String
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object

Dim i As Long, LastRow As Long
Dim Ws As Worksheet
Dim Ws2 As Worksheet

'DATA
Dim A As Variant
Dim B As Worksheet
Dim C As Workbook

Set Ws = ThisWorkbook.Worksheets("Path_Import")
Set Ws2 = ThisWorkbook.Worksheets("DATA_ORDER")

LastRow = Ws.Range("G11").End(xlDown).Row

Ws.Activate

For i = 11 To LastRow

    'Set the file name to a variable
    folderName = Range("G" & i).Value
    
    If folderName <> VBA.Constants.vbNullString Then
    
        'Set all the references to the FSO Library
        Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
        Set FSOFolder = FSOLibrary.GetFolder(folderName)
        Set FSOFile = FSOFolder.Files

        'Use For Each loop to loop through each file in the folder
        For Each FSOFile In FSOFile

            Set A = Application.Workbooks.Open(FSOFile)
    
            Set B = A.Sheets(1)
            
            B.Cells(Rows.Count, 1).End(xlUp).Offset(0, 28).Select
            Range(Selection, Cells(1, 1)).Copy
        
            If Ws2.Range("A1") = "" Then
    
                Ws2.Cells(Rows.Count, 1).End(xlUp).PasteSpecial 'xlPasteValues
    
            Else
                Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial 'xlPasteValues
        
            End If
        
            A.Close SaveChanges:=False

        Next
            
        'Release the memory
        Set FSOLibrary = Nothing
        Set FSOFolder = Nothing
        Set FSOFile = Nothing

    End If

Next i

End Sub

CodePudding user response：

You need to change your loop for statement

For Each FSOFile In FSOFile

For Each FSOFile In FSOFolder.Files

and delete the line Set FSOFile = FSOFolder.Files