Copy all files from folder to another folder with addresses in cells

[gelu]

Hello everyone,

I would be grateful for help with some code which is beyond my ken:
1 - I want to move all files (.txt, .csv, .xlsx, ,xlsm) from a folder to another one
2 - the addresses for:

• the FROM and the TO folders to be in cells so that each level could be changed to something else
• also the names of the files to be moved to be in cells (ideally).

3 - a message box to confirm the move could help but having the option to do the move without the msg box would help, too (in a different circumstance)

Move Files.xlsm
	A
13
MoveFiles

Thank you!

Gelu

 

[rollis13]

First of all you need to add the trailing path separator in your paths; example for row 1: c:\a\2022\ and c:\a\.
And, if you still get Error: '5' you need to check thoroughly all the cells in column A under the last path name. No empty cells between the data and absolutely nothing in the cells below, not even a (invisible) space character. Noticed no other issue.
Made some minor tweaks to the code and exploited the variable ws.

Option Explicit
Sub CopyFiles()
    Dim fileRow As Long
    Dim sourcePath As String
    Dim destinationPath As String
    Dim fileName As String
    Dim newName As String
    Dim LR     As Long
    Dim count  As Long
    Dim FSO    As New FileSystemObject
    Dim ws     As Worksheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets("CopyFiles")
    With ws
        LR = .Range("A" & Rows.count).End(xlUp).Row
        For fileRow = 2 To LR
            sourcePath = .Cells(fileRow, "A").Value
            destinationPath = .Cells(fileRow, "B").Value
            fileName = .Cells(fileRow, "C").Value
            newName = .Cells(fileRow, "D").Value
            If Dir(sourcePath & fileName) <> "" Then
                FSO.CopyFile sourcePath & fileName, destinationPath & newName
                count = count + 1
            End If
        Next
    End With
    If count <> 0 Then MsgBox "Success! " & count & " files copied to " & destinationPath & " and renamed."
End Sub

 

[gelu]

Dear Rollis,

Thank you for pointing out my mistakes and the new code. It does work very well indeed.

Thank you for your help, very valuable.

Best wishes, Gelu

PS: In the meantime 3rd section of homework done. Added two If statements to compensate for yesterday.

Sub CopyFiles()
' https://www.mrexcel.com/board/threads/copy-all-files-from-folder-to-another-folder-with-addresses-in-cells.1218452/page-2#post-5958798
' rollis13
   
    Dim fileRow As Long
    Dim sourcePath As String
    Dim destinationPath As String
    Dim fileName As String
    Dim newName As String
    Dim LR     As Long
    Dim count  As Long
    Dim FSO    As New FileSystemObject
    Dim ws     As Worksheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets("CopyFiles")
    With ws
        LR = .Range("A" & Rows.count).End(xlUp).Row
        For fileRow = 2 To LR
            sourcePath = .Cells(fileRow, "A").Value
            destinationPath = .Cells(fileRow, "B").Value
            fileName = .Cells(fileRow, "C").Value
            newName = .Cells(fileRow, "D").Value
            If Dir(sourcePath & fileName) <> "" Then
                FSO.CopyFile sourcePath & fileName, destinationPath & newName
                count = count + 1
            End If
           
           
            If fileName = "Save As Macro.xlsm" Then
            MsgBox "What?!"
           
            End If
           
            If fileName = "Save As Macro.xlsm" Then
            FSO.CopyFile sourcePath & fileName, destinationPath & fileName
           
            End If
           
           
        Next
    End With
    If count <> 0 Then MsgBox "Success! " & count & " files copied to " & destinationPath & " and renamed."
End Sub

Amazingly it does this:
1- Asks "What?"
2 - copies the whole content (4 files) of source folder with new names to destination
3 - I click Ok in the msgBox
4 - it immediately copies "Save As Macro.xlsm" with the old name, too (I now have 5 files in destination folder because one kept the old name but also got the new one)
5 - I get the old message "Success! 4 files copied to " & destinationPath & " and renamed."

Some If!

 

[rollis13]

No need to use two If/Then, you can use:

If fileName = "Save As Macro.xlsm" Then
    MsgBox "What?!"
    FSO.CopyFile sourcePath & fileName, destinationPath & fileName
End If

I must point out that you got the sequence wrong; it's:
1 - copies the whole content (4 files) of source folder with new names to destination
2 - Asks "What?"
3 - I click Ok in the msgBox
4 - it immediately copies "Save As Macro.xlsm" with the old name
5 - I get the old message "Success! 4 files copied to " & destinationPath & " and renamed."

If Dir(sourcePath & fileName) <> "" Then
FSO.CopyFile sourcePath & fileName, destinationPath & newName count = count + 1
End If

1 - copies the whole content (4 files) of source folder with new names to destination

If fileName = "Save As Macro.xlsm" Then
MsgBox "What?!"

2 - Asks "What?"
3 - I click Ok in the msgBox

FSO.CopyFile sourcePath & fileName, destinationPath & fileName

4 - it immediately copies "Save As Macro.xlsm" with the old name

If count <> 0 Then MsgBox "Success! " & count & " files copied to " & destinationPath & " and renamed."

5 - I get the old message "Success! 4 files copied to " & destinationPath & " and renamed."

 

[gelu]

Thank you so much, I find it amazing these forums exist and people are so generous with their time and knowledge.
Noted the point on the importance of sequence.

PS: I also missed the exclamation point after "What?" ... Could two of them make the point better? "What?!!" ...
No, One does it.