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]

Have a try with this macro to be pasted in a module. Note that you need to activate reference Microsoft Scripting Runtime before using. You can choose with or without feedback, just adjust the code in the macro. Use dummy folders and files for testing.

Option Explicit
Sub MoveFiles()
    'needs reference "Microsoft Scripting Runtime" activation (menu Tools\References)
    Dim fileRow As Long
    Dim sourcePath As String
    Dim destinationPath As String
    Dim fileName As String
    Dim LR     As Long
    Dim answer As String
    Dim count  As Long
    Dim FSO    As New FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    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
        '--- use this for no feedback ------------------------------------
'        If Dir(sourcePath & fileName) <> "" Then
'            FSO.MoveFile sourcePath & fileName, destinationPath & fileName
'            count = count + 1
'        End If
        '-----------------------------------------------------------------
        '--- or use this with feedback -------------------------------------------------------
           If Dir(sourcePath & fileName) <> "" Then
               answer = MsgBox("You are about to move" & vbLf & "file: " & vbTab & fileName & vbLf & "from: " & vbTab & sourcePath & vbLf & "to: " & vbTab & destinationPath, vbYesNo)
               If answer = vbYes Then
                   FSO.MoveFile sourcePath & fileName, destinationPath & fileName
                   count = count + 1
               Else
                   GoTo skipped
               End If
           Else
               MsgBox "File: " & vbTab & fileName & vbLf & "wasn't found" & vbLf & "in: " & vbTab & sourcePath
           End If
skipped:
        '-------------------------------------------------------------------------------------
    Next
    If count <> 0 Then MsgBox "Done! " & count & " files moved"
End Sub

 

[gelu]

Thank you for this beautiful solution!
It makes the spreadsheet sing!

Kind regards,

G

 

[rollis13]

Thanks for the positive feedback, glad having been of some help.

 

[gelu]

Help indeed.
Another weaving, for VBA weavers
(If I should start a new thread please let me know).

Would it also be possible to:
- copy the files from one folder to another
- and change their name in the process?

... again with addresses in cells for all: both paths, old names, new names?

Move Files.xlsm
	A
1	path from
CopyRenameFiles

G

 

[rollis13]

Assuming that all files are to be renamed and that the new names are in column D the minimun coding would be to change the move script.

FSO.MoveFile sourcePath & fileName, destinationPath & Cells(fileRow, "D").Value

As homework you can create a new variable in the same way as the others, add new text to the message box and some If/Then to detect if a file is not to be renamed.

 

[gelu]

Thank you!

 

[gelu]

"As homework you can create a new variable in the same way as the others, add new text to the message box and some If/Then to detect if a file is not to be renamed."

I completed the first two tasks:

Dim ws As Worksheet
Set ws = Worksheets("CopyFiles")

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

I do not know how to handle the third ("f/Then to detect if a file is not to be renamed"). Could you point me to where to start to learn VBA starting from zero (good book or online source)?

There is a little issue with the code you kindly provided (both Move and Copy do the same). If I apply it once it works flawlessly. The second time, (3rd, etc - I did many successive tests), it does the job but it also pops a msg (see image). On Debug it points to:

" FSO.CopyFile sourcePath & fileName, destinationPath & Cells(fileRow, "D").Value"

Any suggestion?

Thank you again! G

 

[rollis13]

In your case most of the time the error '5' is due to missing data (probably in column A). Anyway, since I have no idea where your data is or even what your macro looks like now, please paste it here.
And, by the way, weren't to move your file to another destination ? How come you are using .CopyFile ?

1 - I want to move all files (.txt, .csv, .xlsx, ,xlsm) from a folder to another one

also the names of the files to be moved to be in cells (ideally).

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)

 

[gelu]

I first download them to C:\A\2022, from there I either move or copy/rename them to C:\A (as a source for Power Query when copied).

The code is:

Sub CopyFiles()

    Dim ws As Worksheet
    Set ws = Worksheets("CopyFiles")
    Dim fileRow As Long
    Dim sourcePath As String
    Dim destinationPath As String
    Dim fileName As String
    Dim LR     As Long
    Dim answer As String
    Dim count  As Long
    Dim FSO    As New FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    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
        '--- use this for no feedback ------------------------------------
        If Dir(sourcePath & fileName) <> "" Then
            FSO.CopyFile sourcePath & fileName, destinationPath & Cells(fileRow, "D").Value
            count = count + 1
        End If
        '-----------------------------------------------------------------
        '--- or use this with feedback -------------------------------------------------------
          ' If Dir(sourcePath & fileName) <> "" Then
               'answer = MsgBox("You are about to move" & vbLf & "file: " & vbTab & fileName & vbLf & "from: " & vbTab & sourcePath & vbLf & "to: " & vbTab & destinationPath, vbYesNo)
               'If answer = vbYes Then
                  ' FSO.MoveFile sourcePath & fileName, destinationPath & fileName
                   'count = count + 1
              ' Else
                  ' GoTo skipped
              ' End If
          ' Else
           '    MsgBox "File: " & vbTab & fileName & vbLf & "wasn't found" & vbLf & "in: " & vbTab & sourcePath
        '   End If
skipped:
        '-------------------------------------------------------------------------------------
    Next
    If count <> 0 Then MsgBox "Succes! " & count & "  files copied to " & destinationPath
End Sub