VBA loop throught each cell to copy files

Question

I have an Excel file where columns (icol) each cells contains a path of some files like this :

             column A                         column B          column c
P:\Desktop\Source\Test1-folder\file1.txt       empty column     P:\Desktop\Source\Test1-folder\filetest.txt            
P:\Desktop\Source\Test1-folder\file2.txt        .....

and I need to loop through these cells to copy files from the cells into destination folder, but i couldn't succeed .Can anyone help how to do it?

Dim strSlash As String, destinationFolder As String
Dim lastcolumn As Long, icol As Long, lastLigne As Long
Dim rngCell As Range, rngFiles As Range
Dim FSO As New FileSystemObject
destinationFolder = "P:\Desktop\folderdestination"
Dim maListe As Object
Dim workboo As Workbook
Dim worksh As Worksheet

Set workboo = Workbooks.Open(P:\Desktop\Source\excelfile.xlsx)
Set worksh = workboo.Worksheets("path_files")

lastcolumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
     If Dir(destinationFolder, 16) = "" Then MkDir (destinationFolder)
         For icol = 1 To lastcolumn Step 2
            lastLigne = Cells(Rows.Count, icol).End(xlUp).Row
            Set rngFiles = Cells(1, icol).Resize(lastLigne)
                 For Each rngCell In rngFiles.Cells
                 If Dir(rngCell.Value) <> "" Then 
                 strFile = Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, "\"))
                 If Dir(destinationFolder & "\" & Left(strFile, 5) , 16) = "" Then
                  FSO.CopyFile rngCell.Value, destinationFolder & "\" & Left(strFile, 5)           
                   End If
                 End If
                  Next rngCell
          Next icol

end sub

You have a whole load of syntax errors in there. The destinationFolder needs to be inside quotes, you never declared or set dercol to anything, you appear to be using an FSO object without ever creating it or setting it, you're missing a Next for the first For loop... Have you definitely posted ALL the code? It seems like there's a fair bit missing... — Dave
@Dave i edit it because i put at first just a part of the code — JeanLo
Ok. First, correct the declaration of destination folder to destinationFolder, variables can't have spaces in them. Then replace any instance of worksh with ws as that's what you declared and set to be the worksheet. I still don't see dercol (in the line For k = 1 To dercol) defined anywhere so that's going to initialise to zero and prevent the loop executing. You are still missing a Next as you have two For loops and each needs its own Next... — Dave
And put Option Explicit at the very top of the page; this will tell VBA to ensure that you've declared all variables in use. — Dave
i put just a part of the code because i still have code below in my program . but the main problem is that it doesn't copy any of those files @Dave — JeanLo

user3598756 user3598756 · Accepted Answer · 2016-06-07T09:24:20

edited to add a check for source file existence

this should do

Option Explicit

Sub main()

    Dim strSlash As String, destinationFolder As String
    Dim lastcolumn As Long, icol As Long, lastLigne As Long
    Dim rngCell As Range, rngFiles As Range
    Dim FSO As New FileSystemObject

    strSlash = "\"
    destinationFolder = "P:\Desktop\folderdestination"
    lastcolumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    For icol = 1 To lastcolumn Step 2
        lastLigne = Cells(Rows.Count, icol).End(xlUp).Row
        Set rngFiles = Cells(1, icol).Resize(lastLigne)
        For Each rngCell In rngFiles.Cells
            If Dir(rngCell.Value) <> "" Then '<~~ check if the source file is actually there!
                If Dir(destinationFolder & "\" & Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, strSlash)), 16) = "" Then
                    FSO.CopyFile rngCell.Value, destinationFolder & "\" & Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, strSlash))
                End If
            End If
        Next rngCell
    Next icol

End Sub

but it could still be improved to a good extent, exploiting FileSystemObject more thoroughly (which of course needs adding reference to "Microsoft Scripting Runtime" library: Tools->References and then scroll down List Box and select "Microsoft Scripting Runtime" checkbox)

VBA loop throught each cell to copy files

1 Answers