关于EXCEL清单复制文件到指定文件夹并在EXCEL内标记

hfeng0120

各位大神，请帮帮我下面的代码可以找到文件并复制，但我不知道怎么在EXCEL里标注相应信息。
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, "D:\工作\经营资料\流程\电子化办工-钉钉\钉钉基础信息录入\PDF图纸\汇总\", 0)
    If Not fol1 Is Nothing Then pa1 = fol1.Items.Item.Path Else MsgBox "D:\工作\经营资料\流程\电子化办工-钉钉\钉钉基础信息录入\PDF图纸\汇总\": Exit Sub
    Set fol2 = CreateObject("Shell.Application").BrowseForFolder(0, "D:\工作\经营资料\聚德基础资料\合同\待处理(15、16、001、002修改单）\测试", 0)
    If Not fol2 Is Nothing Then pa2 = fol2.Items.Item.Path Else MsgBox "D:\工作\经营资料\聚德基础资料\合同\待处理(15、16、001、002修改单）\测试": 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 & "\"
                  -----------------------------------------------------------------------我想在这里加入，如果找到相应的文件，就在EXCEL相应的位置写上“找到”
                    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