Copy, Rename and validate multiple excel files

[Bart101]

Hi All, Been scratching around for the last 5 days to find something that works for multiple files. Many a late night/early hours of the morning unsuccessfully piecing together/coding to get a result. Thanks in advance.

The following code is from get-digital-help.com/copyrename-a-file-excel-vba written by Oscar It works for 1 file, Ive got 8,000 files to do across a deep folder structure so I'd really like each row to look at a source path, source file name, destination path and destination file:

For each row:
Column A list the source path
Column B lists the source file name
Column C lists to destination path
Column D lists the new file name

Column E writes "Success" or "Fail" validation.
- if file name already exists in destination, then "Fail"
- If source file doesn't exist, then "Fail"


Nice to have/completely optional!!! https://www.excelforum.com/images/smilies/smile.gif

Check if source file column A&B exists, = True or False record in column F. Where True, then proceed with copy and rename.



If destination file already exist, the fail and column F = duplicate
Leave the first row so I can insert column headers










'Name macro
Sub CopyRenameFile()

'Dimension variables and declare data types
Dim src As String, dst As String, fl As String
Dim rfl As String

'Save source directory specified in cell A2 to variable src
src = Range("A2")

'Save destination directory specified in cell C2 to variable dst
dst = Range("C2")

'Save file name specified in cell B2 to variable fl
fl = Range("B2")

'Save new file name specified in cell D2 to variable rfl
rfl = Range("D2")

'Enable error handling
On Error Resume Next

'Copy file based on variables src and fl to destination folder based on variable dst and name file based on value in rfl
FileCopy src & "" & fl, dst & "" & rfl

'Check if an error has occurred
If Err.Number <> 0 Then

'Show error using message box
MsgBox "Copy error: " & src & "" & rfl
End If

'Disable error handling
On Error GoTo 0

End Sub

[Bart101]

Hi All, This problem is now resolved.
Let me know if its allowed for the link to be pasted from another forum to ensure credit of the original person.

[Paul_Hossler]

Glad you got any answer to your question

Sure you can give credit to the other person

BTW, the next time if you do post the question in any of the other forums, we like to know that so please post a link or links to the other forums

You can read the FAQs at the link in my signature, especially the fourth item

[Bart101]

Thanks Paul.
First time posting, so not sure of the do/dont's :) but will remember for next time.

[snb]

Sub M_snb()
sn=sheet1.cells(1).currentregion.resize(,4)
set sh= CreateObject("shell.application")

for j=1 to ubound(sn)
if dir (sn(j,1) & sn(j,2))<>"" then
if dir(sn(j,3),16)="" then sh.Namespace(split(sn(j,3),":")(0)).NewFolder split(sn(j,3),":")(1)
filecopy sn(j,1) & sn(j,2), sn(j,3) & sn(j,4)
end if
next
End Sub