Question

使用VBA搜索文件并将文件放到指定文件夹

请教高手。现在有300个文件夹（分别以每天的日期命名，如20130528），每个文件夹里有800个文本文件（分别以6位数命名，如135790），现在想找出每个文件夹里这800个文本文件里指定文件名的80的文件（如找出136666,148773等），并把这80个放到另外的一个文件夹。怎么用VBA写程序？或者告诉我要用到哪些语句。

Answer 1

Dim i, j As Long
Dim nPath As String '存放目录名
Dim nTargetPath As String '目标目录名
Dim nFile As String '存放要搜索的文件名

nTargetPath = "d:\mm" '将80个文件移动到 d:\mm 中，当然目录名可以自己改

j = 0 '用于统计移动了多少个文件
For i = 20130501 To 20130529 Step 1
nPath = ""
nFile = ""
nPath = "c:\" + CStr(i) '存放目录名
If Dir(nPath, vbDirectory) <> "" Then '搜索目录是否存在
nFile = nPath + "\" + "136666" '要搜索的文件名
If Dir(nFile, vbArchive + vbHidden + vbNormal + vbReadOnly) <> "" Then '搜索指定文件是否存在
FileCopy nFile, nTargetPath
If Dir(nTargetPath + "136666") Then Kill (nFile) '如果移动成功则删除原先的文件
j = j + 1
End If
nFile = nPath + "\" + "148773" '要搜索的文件名
If Dir(nFile, vbArchive + vbHidden + vbNormal + vbReadOnly) <> "" Then '搜索指定文件是否存在
FileCopy nFile, nTargetPath
If Dir(nTargetPath + "148773") Then Kill (nFile) '如果移动成功则删除原先的文件
j = j + 1
End If
'.......
End If
If j > 80 Then Exit For '如果移动文件数超过80则退出。
Next
这个可以满足你的要求，只要在相应的地方改成你自己的就行了。

追问

感谢作答！不过可能我没描述清楚。
现在就是想把D盘20120511文件夹里的指定80个移到E盘的20120511文件夹；D盘20120512文件夹里的同样名称的80个移到E盘的20120512文件夹·······
其实就是我从系统每天导出来的数据多了很多我不需要的，现在只筛选出需要的那80个放到另一边。另外能不能直接写语句在E盘里直接新建目标文件夹来放那80个文件？

追答

Dim i, j, k, nCount,BeginDate, EndDate As LongDim nPath, FileStr, DriveStr,nTargetPath ,nFile As String
Dim FileArr, DrvArr
BeginDate=20130501 '开始日期,整型
EndDate=20130529 '结束日期
nTargetPath="d:\mm" '将文件移动到 d:\mm 中
DriveStr="c:\,d:\,e:\,f:\" '搜索的盘符，逗号分开
FileStr="136666,148773, ... ,文件n" '指定n个文件名，逗号分开
nCount=0 '统计移动数
'判断目录不存在则建立
If Dir(nTargetPath, vbDirectory) "" Then MkDir (nTargetPath)
FileArr=Split(FileStr, ",")
DrvArr=Split(DriveStr, ",")
For i = BeginDate To EndDate Step 1
For j = 0 To UBound(DrvArr) Step 1
nPath=""
nFile=""
nPath=DrvArr(j)+CStr(i)
If Dir(nPath, vbDirectory) "" Then'搜索目录是否存在
For k = 0 To UBound(FileArr) Step 1
nFile=nPath+"\"+FileArr(k)
If Dir(nFile, vbArchive + vbHidden + vbNormal + vbReadOnly) "" Then '搜索指定文件是否存在
FileCopy nFile, nTargetPath
'如移动成功则删除原先的文件
If Dir(nTargetPath + FileArr(k), vbArchive + vbHidden + vbNormal + vbReadOnly) Then Kill (nFile)
nCount=nCount+1
End If
Next k
End If
If nCount>80 Then Exit For
Next j
Next i

Answer 2

使用VBA搜索文件并将文件放到指定文件夹，参考代码如下：
Dim lngRow As Integer
Dim lngMaxRows As Integer

Dim strFileName As String
Dim strSrcFilePath As String
Dim strDesFilePath As String

Dim strSrcPath As String: strSrcPath = "C:\Users\Administrator\Desktop\SrcImg\" '源文件夹路径，请自行修改
Dim strDesPath As String: strDesPath = "C:\Users\Administrator\Desktop\DesImg\" '目标文件夹路径，请自行修改

Dim objFileSystem As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")

lngMaxRows = Range("A1048576").<a href="https://www.baidu.com/s?wd=End&tn=44039180_cpr&fenlei=mv6quAkxTZn0IZRqIHckPjm4nH00T1Y4mHnYPWFBuH9-rj-BPWRd0ZwV5Hcvrjm3rH6sPfKWUMw85HfYnjn4nH6sgvPsT6K1TL0qnfK1TL0z5HD0IgF_5y9YIZ0lQzqlpA-bmyt8mh7GuZR8mvqVQL7dugPYpyq8Q1RYrj0Yn1Dvnf" target="_blank" class="baidu-highlight">End</a>(xlUp).Row '如果Excel版本为2003，请将1048576改为65536

For lngRow = 1 To lngMaxRows
strFileName = Cells(lngRow, 1).Value & ".jpg" '默认扩展名为.jpg

strSrcFilePath = strSrcPath & strFileName
strDesFilePath = strDesPath & strFileName

If objFileSystem.FileExists(strSrcFilePath) Then
objFileSystem.CopyFile strSrcFilePath, strDesFilePath