现有复制文件的代码基础上添加，是否成功的判断

XCH1306

有一个代码，是根据Excel中单元格的内容，从一个文件夹复制到指定文件夹中，现在想在这个程序的基础上添加一个是否成功的判断。麻烦大神帮帮忙

XCH1306

Sub CopyFiles()
'    适合源文件夹及其子文件夹(多层文件夹)
    Dim a$(), b$(), n&, i%, j&, fso1 As Object, fol1 As Object, fol2 As Object, arr, pa1$, pa2$
    Set fol1 = CreateObject("Shell.Application").BrowseForFolder(0, "源文件夹", 0)
    If Not fol1 Is Nothing Then pa1 = fol1.Items.Item.Path Else MsgBox "源文件夹": Exit Sub
    Set fol2 = CreateObject("Shell.Application").BrowseForFolder(0, "目标文件夹", 0)
    If Not fol2 Is Nothing Then pa2 = fol2.Items.Item.Path Else MsgBox "目标文件夹": Exit Sub
    Set fso1 = CreateObject("Scripting.FileSystemObject")
    Call Fso(pa1, a, b, n)
    arr = Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(arr)
        For j = 1 To n
            If b(j) Like arr(i, 1) & "*" Then
                If Not fso1.FileExists(pa2 & "" & b(j)) Then
                    fso1.CopyFile a(j), pa2 & ""
                    Exit For
                End If
            End If
        Next
    Next
    MsgBox "复制完毕！"
End Sub
Sub Fso(myPath$, arr$(), brr$(), n&, Optional ef$ = "*.*")
    Dim fld As Object, f As Object, fd As Object
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
    For Each f In fld.Files
        If f.Name Like ef Then
            n = n + 1
            ReDim Preserve arr(1 To n)
            ReDim Preserve brr(1 To n)
            arr(n) = f.Path: brr(n) = f.Name
        End If
    Next
    For Each fd In fld.SubFolders
        Call Fso(fd.Path, arr, brr, n, ef)
    Next
End Sub

XCH1306

上面是原始代码