VBA code - Moving files not working

superfb

Active Member
Joined
Oct 5, 2011
Messages
251
Office Version
  1. 2007
Platform
  1. Windows
Sub copy()
Dim r As Long
Dim SourcePath As String
Dim dstPath As String
Dim myFile As String
Set FSO = CreateObject("Scripting.FileSystemObject")

On Error GoTo ErrHandler
For r = 2 To Range("D" & Rows.Count).End(xlUp).Row
SourcePath = Range("D" & r)
dstPath = Range("E" & r)
myFile = Range("A" & r)
FileSystemObject.CopyFile SourcePath, dstPath
If Range("D" & r) = "" Then
Exit For
End If
Next r
MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED"
ErrHandler:
MsgBox "Copy error: " & SourcePath & vbNewLine & vbNewLine & _
"File could not be found in the source folder", , "MISSING FILE(S)"
'Range("A" & r).copy Range("E" & r)
Resume Next
End Sub

i have a list of files in column d that i would like to move as per col e however nothing is copying over......can someone please help?
 
Yes it gets picked up via the msg box

In that case, comment out or temporarily delete...

Code:
On Error GoTo ErrHandler

Then, run the code again. This time, when it errors out, see what values have been assigned to SourcePath and dstPath, and see what type of error it is.

Which error number is it, and what does the description say?
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Hi,

so i believe the file does get copied over, but whatever the last row of data is.....the VBA code tells the message box to appear to say there is an error with whatever the last file is..........
 
Upvote 0
In that case, comment out or temporarily delete...

Code:
On Error GoTo ErrHandler

Then, run the code again. This time, when it errors out, see what values have been assigned to SourcePath and dstPath, and see what type of error it is.

Which error number is it, and what does the description say?

Run time error 20 appears
 
Upvote 0
Run time error 20 appears

That's because no error has occurred when the statement "Resume Next" is executed, and so there's nowhere to resume to. You should exit the sub after exiting the "For/Next" loop and displaying the message box that notifies the user where the files can be found. You can use the following line...

Code:
Exit Sub

However, instead of using "On Error GoTo ErrHandler/Resume Next" to essentially check whether a file exists, I would suggest you use the FileExists method of the FileSystemObject...

Code:
If fso.FileExists(SourcePath) Then
 
Upvote 0
That's because no error has occurred when the statement "Resume Next" is executed, and so there's nowhere to resume to. You should exit the sub after exiting the "For/Next" loop and displaying the message box that notifies the user where the files can be found. You can use the following line...

Code:
Exit Sub

However, instead of using "On Error GoTo ErrHandler/Resume Next" to essentially check whether a file exists, I would suggest you use the FileExists method of the FileSystemObject...

Code:
If fso.FileExists(SourcePath) Then

Thank you for the reply

should the code look like this

Code:
Sub copy()
Dim r As Long
    Dim SourcePath As String
    Dim dstPath As String
    Dim myFile As String
    Dim FSO As Object
    
     Set FSO = CreateObject("Scripting.FileSystemObject")
     
   ' On Error GoTo ErrHandler
   If FSO.FileExists(SourcePath) Then
    For r = 2 To Range("D" & Rows.Count).End(xlUp).Row
    SourcePath = Range("D" & r)
    dstPath = Range("E" & r)
    myFile = Range("A" & r)
        FSO.CopyFile SourcePath, dstPath & "\"
        If Range("D" & r) = "" Then
           Exit For
        End If
    Next r
        MsgBox " Number of files copied over: " & r - 2 & vbNewLine, , "COPY COMPLETED"
        Exit Sub
'ErrHandler:
    'MsgBox "Copy error: " & SourcePath & vbNewLine & vbNewLine & _
    '"File could not be found in the source folder", , "MISSING FILE(S)"
'Range("A" & r).copy Range("E" & r)
Resume Next
End Sub
[/QUOTE]


but i recieve the following error block if without end if
 
Upvote 0
Maybe something like this...

Code:
Option Explicit

Sub copy()


    Dim r As Long
    Dim FileCount As Long
    Dim SourcePath As String
    Dim dstPath As String
    Dim myFile As String
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
     
    On Error GoTo ErrHandler
    
    FileCount = 0
    For r = 2 To Range("D" & Rows.Count).End(xlUp).Row
        SourcePath = Range("D" & r).Value
        dstPath = Range("E" & r).Value
        'myFile = Range("A" & r).Value
        If FSO.FileExists(SourcePath) Then
            FSO.copyfile SourcePath, dstPath & "\"
            FileCount = FileCount + 1
        End If
    Next r
    
    MsgBox "Number of files copied over: " & FileCount, vbInformation, "COPY COMPLETED"
    
ExitHandler:
    Set FSO = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    Resume ExitHandler
    
End Sub

For a file that does not exist, you could have "N/A" returned in a cell in the corresponding row. So, for example, if you wanted to use Column F, you would replace...


Code:
        If FSO.FileExists(SourcePath) Then
            FSO.copyfile SourcePath, dstPath & "\"
            FileCount = FileCount + 1
        End If

with

Code:
        If FSO.FileExists(SourcePath) Then
            FSO.copyfile SourcePath, dstPath & "\"
            FileCount = FileCount + 1
        Else
            Range("F" & r).Value = "N/A"
        End If
 
Upvote 0

Forum statistics

Threads
1,214,606
Messages
6,120,490
Members
448,967
Latest member
visheshkotha

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top