利用Excel 快速查找文件

1、打开excel并将以下VBA代码复制到Excel的VBA编辑器中：

不懂得怎么打开VBA工具的，可以参考下我的另一篇 

“怎么批量修改文件名-高级篇 ”

Sub 快速查找文件并复制()

Dim souf$, desf$, rng!, index!, endL!

Dim fileName As String, savePath As String, sourPath As String

Dim objFileSystem As Object

Set objFileSystem = CreateObject("Scripting.FileSystemObject")

 sourPath = "D:\完全共享\追溯表\P29追溯表\P29质保书\"  '要查找的文件所在位置

 savePath = "D:\Desktop\存储位置\"  '找到后将文件复制到此位置

 index = 1 '要查找的文件名所在列

Set mWorkBook = ActiveWorkbook

'filePath = Replace(mWorkBook.Name, ".xlsx", "")

Set mSheet = ActiveWorkbook.ActiveSheet

endL = mSheet.Range("a1000").End(xlUp).Row '获取A列的有效行数

On Error Resume Next '已经存在此文件夹则不创建

VBA.MkDir (savePath & filePath2)  '创建存储的文件夹

    For rng = 1 To endL '要查找的文件名列表循环

       fileName = mSheet.Cells(rng, index)

       souf = sourPath & fileName

       If objFileSystem.FileExists(souf) = True Then '判断文件是否存在

        desf = savePath & fileName

        FileCopy souf, desf

        mSheet.Cells(rng, index).Interior.Color = 65535

       End If

Next

MsgBox "执行完毕！"

End Sub

2、修改代码中两处位置的路径：

1.文件库所在位置的路径

2.找到文件后存放的位置路径

3、将要查找的文件名，填写到Excel的A列,如图：

4、运行VBA代码，立即就可以自动查找好所需要的文件啦。

当查找到所需文件会把文件名标注成黄色底色，为查找到则不变色