PDA

View Full Version : Copy File List - Show Which Files Were Copied Succesfully



Enright
08-12-2016, 07:14 AM
Hello!

I have a working macro that will copy a List of Files(beginning with H6) from a Source Folder(B5) to a Destination Folder (B6)

We are working with client files which is never as you expect, so sometimes we will try to copy a file that does not exist in the Source Folder(B5).

What should I add to the code so that it identifies files that were not copied successfully? I can't seem to find any resources that address this.


Sub InvoicePull2()
Dim R As Range
Dim SourcePath As String, DestPath As String, FName As String
SourcePath = Range("B5").Value
DestPath = Range("B6").Value
For Each R In Range("H9 ", Range("H" & Rows.Count).End(xlUp))
FName = Dir(SourcePath & R)
Do While FName <> ""
FileCopy SourcePath & FName, DestPath & FName
FName = Dir()
Loop
Next
End Sub

Kenneth Hobs
08-12-2016, 08:17 AM
Starting at H6 and not H9? If you are listing the filenames in column H, why would a Dir loop be needed?

Why would you need to do that? You should probably fist check that Source and Target/Destination paths exist. Before FileCopy() you should also check that the filename exists. If you do need to check for success, then you can do the same for DestPath & Fname after FileCopy(). Of course what you do with that is a question that needs an answer.

Just use Len(Dir()) <>0 to check for vbDirectory and filename existence. As written with the Len() checks added, it should work for you. You can add the final check as I explained though that should be redundant. I guess it could fail to copy if you have a power outage or other error like running out of disk space.

FWIW: Dir() methods don't work well in some cases when a routine has Dir() call loops and calls other routines where they use Dir()'s loops as well.

e.g.

Debug.Print len(dir(thisworkbook.Path,vbDirectory))<>0
'True
debug.Print len(dir(thisworkbook.FullName))<>0
'True

This method just changes the font color to red if the copy did not happen for some reason.

Sub InvoicePull_Ken()
Dim R As Range, SourcePath As String, DestPath As String, FName As String
Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")


SourcePath = Range("B5").Value2
If Len(Dir(SourcePath, vbDirectory)) = 0 Then
MsgBox SourcePath & " does not exist.", vbCritical, "Macro Ending"
Exit Sub
End If

DestPath = Range("B6").Value2
If Len(Dir(DestPath, vbDirectory)) = 0 Then
MsgBox DestPath & " does not exist.", vbCritical, "Macro Ending"
Exit Sub
End If

For Each R In Range("H9 ", Range("H" & Rows.Count).End(xlUp))
R.Font.Color = vbNormal
If Len(Dir(SourcePath & R.Value2)) = 0 Then
R.Font.Color = vbRed
GoTo NextR
End If

'Can be a permission issue. e.g. Trying to copy this open file.
'FileCopy SourcePath & R.Value2, DestPath & R.Value2
'Not foolproof but a bit safer copy...
fso.CopyFile SourcePath & R.Value2, DestPath & R.Value2

If Len(Dir(DestPath & R.Value2)) = 0 Then 'Source file did not copy to Dest.
R.Font.Color = vbRed
End If
NextR:
Next R

Set fso = Nothing
End Sub