VB在指定文件夹内搜索一个文件并且要做到能复制、删除和移动到指定文件夹
发布网友
发布时间：2023-01-10 15:59
共3个回答
热心网友
时间：2023-10-25 20:36
Dim F As Folder, Fso As New FileSystemObject, Found As Boolean
Dim PathFn As String
Set F = Fso.GetFolder(Text1.Text)
If Not F Is Nothing Then
Text2.Text PathFn = Dfs(F, "A.txt", Found)
Text2.Text = PathFn
If Found = True Then
'复制
Fso.CopyFile PathFn, "目标文件夹", True
'删除
Fso.DeleteFile PathFn, True
'移动
Fso.MoveFile PathFn, "目标文件夹"
End If
End If
End SubFunction Dfs(F As Folder, ByVal fn As String, ByRef Found As Boolean) As String
'F:输入参数,要查找的文件夹对象,Fn:输入参数,要查找的文件名,全名,带扩展名,Found:输出参数,返回是否找到
Dim T As File
For Each T In F.Files
If T.Name = fn Then
Found = True
Exit For
End If
Next
If Found = True Then
Dfs = T.Path & "\" & T.Name
Exit Function
Else
Dim T2 As Folder
For Each T2 In F.SubFolders
Dfs = Dfs(T2, fn, Found)
If Found = True Then
Exit Function
End If
Next
Dfs = ""
End IfEnd Function
热心网友
时间：2023-10-25 20:37
Dim sChildDir() As String
Dim sFileName As String
Dim lDirNum As Long
Dim lCount As Long
On Error GoTo SearchPathErr
If Right(sPath, 1) <> "\" Then sPath = sPath + "\"
sFileName = Dir(sPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
While sFileName <> ""
Do While A = False
DoEvents
Loop
Me.Caption = sPath '这里在标题栏显示当前查找的目录、你可以根据需要去掉
'因为文件过多可能会给人死掉的假象、所以标题栏显示出当前查找的目录
DoEvents If (GetAttr(sPath + sFileName) And vbDirectory) = vbDirectory Then
If sFileName <> "." And sFileName <> ".." Then
ReDim Preserve sChildDir(lDirNum) As String
sChildDir(lDirNum) = sFileName
lDirNum = lDirNum + 1
End If Else If UCase$(FindName) = UCase$(sFileName) Then
If MsgBox("已经找到文件、存在于目录：" & sPath & vbCrLf & "是否停止查找并运行？", vbQuestion + vbYesNo) = vbYes Then
Call Shell("cmd /c start " & sPath & sFileName, vbHide)
Exit Function
End If
End If
End If sFileName = Dir
Wend
For lCount = 0 To lDirNum - 1
Call SearchPath(sPath + sChildDir(lCount), FindName)
Next
Erase sChildDir
SearchPath = True
Exit Function
SearchPathErr:
SearchPath = False
End Function这是一个简单的搜索函数应该看了声明就知道怎么用了吧 ？ 比如在C盘搜索 a.txt这个文件SearchPath "C:\", "a.txt"想要复制就用filecopy 函数 移动的话可以先复制然后删除原来的文件 用 kill函数就可以
热心网友
时间：2023-10-25 20:37
