本例，我们来学习一个文件查找并自动复制粘贴到其它文件夹的方法；
该问题的提出，来源于网络的一个网友，其名称为“Office菜”；他的需求如下：
在Excel的第一个表里面的任意单元格中，保存有文件的名称，仅保留文件基本名，不包含扩展名；他想要的结果是：根据excel单元格的文件的名称，查找某文件夹里面，是否存在这个文件；如果存在，那么，就自动将该文件复制粘贴到其它文件夹。
大众计算机学习网，为解决该问题，特意制作了本例，希望遇到同类问题的网友，通过学习，得以解决工作上的需求。
如下图，假如，D盘下面，有两个文件夹，分别为：MyPcs和GoodPC；
MyPcs文件夹，里面存放N张图片或N个文件；如下图！
而GoodPC文件夹，是一个空的文件夹，如下图！
下面，我们要做的就是，根据如下的Excel的第一个表，该表的单元格，保存有文件的名称，注意，只保存文件的基本名，不包括扩展名；
要实现的最终效果就是，根据该表的单元格的文件基本名，自动寻找MyPcs文件夹，是否存在该名称的文件，如果存在，那么，就将该文件自动复制粘贴到GoodPC文件夹里面。
具体的实现方法是，在Excel表里面，添加一个按钮，之后，编写按钮的VBA代码即可。
为方便大家的学习，现将代码粘贴如下，供大家使用！
Private Sub CommandButton1_Click()
Dim iTemp1, iTemp2 As Integer
Dim sTemp1 As String
Dim totalFiles As Integer
Dim MyPCName
sTemp = "D:\MyPcs\" ' 指定的扫描目录，文件夹使用英文，注意，路径的后面有一个\符号
CopyPath = "D:\goodpc\" '将找到的文件粘贴到这个目录，文件夹使用英文，注意，路径的后面有一个\符号
Set FS = Application.FileSearch
With FS
.LookIn = sTemp
.Filename = "*.*"
.MatchAllWordForms = False
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
totalFiles = .FoundFiles.Count
For iTemp1 = 1 To totalFiles
sTemp1 = .FoundFiles(iTemp1)
iTemp2 = InStrRev(sTemp1, "\")
If iTemp2 <> 0 Then sTemp1 = Mid(sTemp1, iTemp2 + 1)
''s = s & sTemp1'截取文件名
''s = s & vbCrLf'给变量加一个回车符
MyPCName = Left(sTemp1, Len(sTemp1) - 4) '截取文件名的基本名，不要扩展名
For i = 1 To 1000 '行的最大值
For j = 1 To 500 '列的最大值
If (Trim(Worksheets(1).Cells(i, j).Value) = MyPCName) Then
FileCopy sTemp & sTemp1, CopyPath & sTemp1 '复制粘贴到这个目录
End If
Next
Next
Next iTemp1
'MsgBox s '将文件夹的文件名称通过对话框显示出来
End If
End With
End Sub
以上代码，均本人测试，通过；经Office菜测试，不存在任何问题；
希望本文对您有所帮助，若需转载，请注明本站地址！