文件名查找目录文件并复制粘贴到其它文件夹
本例，我们来学习一个文件查找并自动复制粘贴到其它文件夹的方法；
该问题的提出，来源于网络的一个网友，其名称为“Office菜”；他的需求如下：
在Excel的第一个表里面的任意单元格中，保存有文件的名称，仅保留文件基本名，不包含扩展名；他想要的结果是：根据excel单元格的文件的名称，查找某文件夹里面，是否存在这个文件；如果存在，那么，就自动将该文件复制粘贴到其它文件夹。
操作方法
- 01
如下图，假如，D盘下面，有两个文件夹，分别为：MyPcs和GoodPC；
- 02
MyPcs文件夹，里面存放N张图片或N个文件；如下图！
- 03
而GoodPC文件夹，是一个空的文件夹，如下图！
- 04
下面，我们要做的就是，根据如下的Excel的第一个表，该表的单元格，保存有文件的名称，注意，只保存文件的基本名，不包括扩展名；
- 05
要实现的最终效果就是，根据该表的单元格的文件基本名，自动寻找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菜测试，不存在任何问题 Come from http://www.dzwebs.net Article Url��http://www.dzwebs.net/2323.html