怎么用vba 做一个文件搜索程序

代码及注释如下：

sub main

dim fs

Set fs = Application.FileSearch'定义fs为文件搜索

With fs

.LookIn = "C:\"'搜索位置为C盘根目录

.FileName =worksheets("sheet1").cells(1,1) ’搜索名称为工作表1中的第一个单元格

If .Execute >0 Then'如果搜索结果不为空

For i = 1 To .FoundFiles.Count

worksheets("sheet1").cells(i,2)= .FoundFiles(i)'遍历所有文件，并将之放到第二列中

Next i

Else

MsgBox "There were no files found."'如果找不到，则提示没找到

End If

End With

end sub

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

这个可以满足你的要求，只要在相应的地方改成你自己的就行了。

以下代码，楼主可以参考，打开文件夹，选择文件后自动打开

Sub text()

With Application.FileDialog(msoFileDialogFilePicker)

.InitialFileName = ThisWorkbook.Path &"\"

.Title = "请选择对应文本文件"

.AllowMultiSelect = False

If .Show Then f = .SelectedItems(1) Else Exit Sub '

End With

Shell "RUNDLL32.EXE URL.DLL,FileProtocolHandler " &f, vbMaximizedFocus

End Sub

---