• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy & Rename file

A

Abhijeet

Active Member
Hi

In this macro copy file & rename and paste that to particular folder but i want update status in Column D file is already exits or able to save that file then Done please tell me how to do this
Code: 
Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Sub CopyRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim i As Long, LRow As Long
LRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LRow
'Source directory
src = Range("B2")
'Destination directory
dst = Range("C2")
'File name
fl = Range("A2")
'Rename file
rfl = Range("E" & i)
If file_exists(dst) = "Exists" Then
        MsgBox "File already exists at destination folder so can not be moved ", vbInformation, "Note:"
        Exit Sub
    End If
On Error Resume Next
    FileCopy src & "\" & fl, dst & "\" & rfl
    If Err.Number <> 0 Then
        MsgBox "Copy error: " & src & "\" & rfl
    End If
On Error GoTo 0

    Next i
   

End Sub
 

Attachments

  • copy File to another folder test .xlsm
    21.9 KB · Views: 8
At the part where you check if the file exists, it's currently giving you a msgbox. Change that to instead write something to the cell.

e.g.,
change this:
Code: 
If file_exists(dst) = "Exists" Then
        MsgBox "File already exists at destination folder so can not be moved ", vbInformation, "Note:"
        Exit Sub
    End If

to this
Code: 
If file_exists(dst) = "Exists" Then
    Cells(i, "D").Value = "File already exists at destination folder so can not be moved"
Else
    Cells(i, "D").Value = "Done"
End If
 
Abhijeet said:
Hi

In this macro copy file & rename and paste that to particular folder but i want update status in Column D file is already exits or able to save that file then Done please tell me how to do this
Code: 
Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Sub CopyRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim i As Long, LRow As Long
LRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LRow
'Source directory
src = Range("B2")
'Destination directory
dst = Range("C2")
'File name
fl = Range("A2")
'Rename file
rfl = Range("E" & i)
If file_exists(dst) = "Exists" Then
        MsgBox "File already exists at destination folder so can not be moved ", vbInformation, "Note:"
        Exit Sub
    End If
On Error Resume Next
    FileCopy src & "\" & fl, dst & "\" & rfl
    If Err.Number <> 0 Then
        MsgBox "Copy error: " & src & "\" & rfl
    End If
On Error GoTo 0
 
    Next i
  
 
End Sub
Click to expand...
Are you looking for this, please check file...
 

Attachments

  • copy_File_to_another_folder_test_(1).xlsm
    19.3 KB · Views: 10
There are few issue with your code.

1. You have src, dst & fl all hard coded. Replace each of those with Range("col" & i).
2. file_exists(dst) portion needs to be changed to file_exists(dst & "\" & rfl) to get right result
3. You need "GoTo xxxx:" after file_exists check to skip some of the operation in between

Code should be...
Code: 
Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Sub CopyRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim i As Long, LRow As Long
LRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LRow
'Source directory
src = Range("B" & i)
'Destination directory
dst = Range("C" & i)
'File name
fl = Range("A" & i)
'Rename file
rfl = Range("E" & i)
If file_exists(dst & "\" & rfl) = "Exists" Then
        Range("D" & i) = "File Exists"
    GoTo Skip:
    End If
On Error Resume Next
    FileCopy src & "\" & fl, dst & "\" & rfl
    If Err.Number <> 0 Then
        MsgBox "Copy error: " & src & "\" & rfl
    Else
        Range("D" & i) = "Done"
    End If

On Error GoTo 0
Skip:
    Next i
  

End Sub
 
Hi Luke M
I tried this but this give result if Column E files if already exits then also Update in Column D Done can u pls tell me i want if that file is already exits then that is i want update in column D if not then move that file then Done message
Code: 
Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Sub CopyRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim i As Long, LRow As Long
LRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LRow
'Source directory
src = Range("B2")
'Destination directory
dst = Range("C2")
'File name
fl = Range("A2")
'Rename file
rfl = Range("E" & i)
If file_exists(dst) = "Exists" Then
    Cells(i, "D").Value = "File already exists at destination folder so can not be moved"
Else
    Cells(i, "D").Value = "Done"
End If
   
If file_exists(dst) = "Not Exists" Then
On Error Resume Next
FileCopy src & "\" & fl, dst & "\" & rfl
'Range("D" & i).Value = "File moved"
End If
If Err.Number <> 0 Then
        MsgBox "Copy error: " & src & "\" & rfl
    End If
On Error GoTo 0

    Next i
   

End Sub
 
Chihiro said:
There are few issue with your code.

1. You have src, dst & fl all hard coded. Replace each of those with Range("col" & i).
2. file_exists(dst) portion needs to be changed to file_exists(dst & "\" & rfl) to get right result
3. You need "GoTo xxxx:" after file_exists check to skip some of the operation in between

Code should be...
Code: 
Function file_exists(fl_path As String) As String
    If Dir(fl_path) <> "" And fl_path <> "" Then
        file_exists = "Exists"
    Else
        file_exists = "Not Exists"
    End If
End Function
Sub CopyRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim i As Long, LRow As Long
LRow = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LRow
'Source directory
src = Range("B" & i)
'Destination directory
dst = Range("C" & i)
'File name
fl = Range("A" & i)
'Rename file
rfl = Range("E" & i)
If file_exists(dst & "\" & rfl) = "Exists" Then
        Range("D" & i) = "File Exists"
    GoTo Skip:
    End If
On Error Resume Next
    FileCopy src & "\" & fl, dst & "\" & rfl
    If Err.Number <> 0 Then
        MsgBox "Copy error: " & src & "\" & rfl
    Else
        Range("D" & i) = "Done"
    End IF

On Error GoTo 0
Skip:
    Next i
 

End Sub
Click to expand...
Hi i tried this code but not work only 1st files is work well next file is error message Copy Error:\102.xls like this
 
Abhijeet said:
Hi i tried this code but not work only 1st files is work well next file is error message Copy Error:\102.xls like this
Click to expand...
I check this u change in coding part src = Range("B" & i)
fl = Range("A" & i) thats why means i want to paste each cell Info yes its work
 
Yep, it treats each file with distinct path. Therefore you need to either enter info in B & C manually or if it is same as B2 & C2 just copy down.
 
You must log in or register to reply here.
Back
Top