CODEWITHSUNDEEP
vbafor-loop
cdfj
cdfj

Reputation: 165

For each... Next not looping

I have a macro that uses a string in the filename to identify the folder to move the file to. It looks up the string in column A and builds the folder name using the country name retrieved from the adjacent cell in column B.

The If statement executes correctly (moves the file correctly). However, the For each... Next looping through the files doesn't work and I cannot see why not.

Thanks in advance for the help.

Sub MoveFiles_SpecificFolders_Loop()

Dim SrepFSO As FileSystemObject
Dim Srep As File
Dim fso As New FileSystemObject
Dim HoldingFolder As String
Dim TargetFolder As String
Dim HldFolder As Folder
Dim i As Integer

HoldingFolder = "C:\Users\xyz\Holding\"
TargetFolder = "C:\Users\xyz\Countries\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set SrepFSO = New Scripting.FileSystemObject
Set HldFolder = SrepFSO.GetFolder(HoldingFolder)

    For Each Srep In HldFolder.Files
    
        For i = 2 To 50
   
        If InStr(Srep, Sheet2.Cells(i, 1)) <> 0 Then
        SrepFSO.MoveFile Source:=SrepFSO.GetFile(Srep), _
        Destination:=TargetFolder & Sheet2.Cells(i, 1).Offset(, 1) & "\" & Srep.Name

        End If
        
        Next i
        
    Next Srep

End Sub

Upvotes: 0

Views: 241

Answers (1)

Super Symmetry
Super Symmetry

Reputation: 2875

You need to exit the inner for loop once the file has been moved.

Try this

Sub MoveFiles_SpecificFolders_Loop()

Dim SrepFSO As FileSystemObject
Dim Srep As File
Dim fso As New FileSystemObject
Dim HoldingFolder As String
Dim TargetFolder As String
Dim HldFolder As Folder
Dim i As Integer

HoldingFolder = "C:\Users\xyz\Holding\"
TargetFolder = "C:\Users\xyz\Countries\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set SrepFSO = New Scripting.FileSystemObject
Set HldFolder = SrepFSO.GetFolder(HoldingFolder)

    For Each Srep In HldFolder.Files
    
        For i = 2 To 50
   
        If InStr(Srep, Sheet2.Cells(i, 1)) <> 0 Then
            If Not SrepFSO.FolderExists(TargetFolder & Sheet2.Cells(i, 2)) then
                SrepFSO.CreateFolder TargetFolder & Sheet2.Cells(i, 2)
            End if
            
            SrepFSO.MoveFile Source:=SrepFSO.GetFile(Srep), _
            Destination:=TargetFolder & Sheet2.Cells(i, 2) & "\" & Srep.Name
            Exit For
        End If
        
        Next i
        
    Next Srep

End Sub

Upvotes: 2

Related Questions