Looping File Movement with Multiple Folders

[jablo1312]

Hello,

I have the following code that transfers all the Excel files in Folder 1 to Folder 2:

Sub Move_NRAuto()
    Dim fso As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String


    FromPath = "\\TJ-file-dfs-01\Central\DataList\[B]Folder1[/B]"  
    ToPath = "\\TJ-file-dfs-01\Central\DataList\[B]Folder2[/B]"   


    FileExt = "*.csv*"


    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If


    Set fso = CreateObject("scripting.filesystemobject")


    If fso.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If


    If fso.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If


    fso.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath
    
    End Sub

I'm trying to amend this code so that instead of hard coding "Folder1" into the code, I can loop this process through a number of folders (Folder 1, Folder 3, Folder 4, etc) and move all of the files in each of those folders into "Folder2".

Is this possible?

 

[storm8]

how are the folder paths determined? do you have a list of them somewhere in your excel file?

 

[jablo1312]

Right now, the folder paths are listed in a column in the active workbook- here is the code:

Sub Move_File(ByVal FromPath As String, ByVal ToPath As String)    Dim fso As Object
    Dim FileExt As String


    FileExt = "*.csv*"


    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If


    Set fso = CreateObject("scripting.filesystemobject")


    If fso.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If


    If fso.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If


    fso.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
    
    End Sub
Sub MoveFolders()


    Dim Cell As Range
    Dim EndRow As Long
    Dim Rng As Range
    Dim Wks As Worksheet


        Set Wks = ActiveSheet  ' You can assign this to a specific sheet in the workbook if you want to
        Set Rng = Wks.Range("A1:A10")


        EndRow = Wks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
        Set Rng = Rng.Resize(EndRow - Rng.Row + 1, 1)


            For Each Cell In Rng
                Call Move_File(Cell.Value, "\\Lm-file-dfs-01\Central\Permkt\Permkt-Temp\_MasterUserAnalytics")
            Next Cell


End Sub

The 2nd sub calls each folder that is listed in the range ("A1:A10") in the "ActiveSheet" and runs it through the first sub.This does the job I want, but I'd prefer to have the folder paths integrated into the code and then run through the first sub using an array and a loop function, or something similar.

 

[storm8]

I'd recommend keeping it the way it is - have one sub loop trough all folders and second to move the files. But if you insist on having it in 1 this would be solution

Sub mysub()


    Dim rng As Range, arr As Variant, i As Integer
    Dim fromPath As String
    Set rng = Range("A1").Resize(10, 1) 'assumes there are 10 folders starting at A1
    arr = rng.Value 'loads range contents to array for faster processing
    For i = LBound(arr) To UBound(arr)
        
        fromPath = arr(i, 1)
        'here goes your original code
    
    Next i
    


End Sub

 

[jablo1312]

I'm fine with it being 2 subs, I'm just wondering if there is a more efficient/integrated way to incorporate all the file paths besides just listing them out in the document. If not, I'm ok with this being how it is done.