Question

VB查找指定文件夹并获取文件路径的代码

比如在文本框1内输入要找的文件名，按下按钮就可以找到，并且将文件路径显示在文本框2中。 告诉我代码或者直接发源码，成功了就采纳

Answer 1

1.首先打开Excel电子表格，然后在开发工具中打开VBA编辑器，如下图。

2.在单元格区域输入一些内容，如下图。

3.将模块插入到VBA编辑器中，如下图。

4.文件的子访问路径()Dimfiless,tempfiless=Application。GetOpenFilename(，，“打开文件”)如果filess=False，那么MsgBox“你没有选择知道选择文件，程序将退出!”:ExitSubtemp=Split(filess，"\")。

5.MsgBox "you choose" & temp(UBound(temp)) & "the path is:" & Chr(10) & filess _& Chr(10) & "the current table path is:" & Chr(10) & thisworkbook. "全名，vbokonty+64，“返回路径”结束子。在模块中输入代码并运行它，如下图。

6.然后点击“执行”按钮，程序弹出“选择文件”对话框。选择文件后，程序立即弹出所选文件的路径，然后弹出当前工作簿的路径，如下图。

Answer 2

新建一个exe工程

添加Text1,Text2,Command1,List1

粘贴下面代码就能运行使用了

Dim kz As Boolean
Private Function SearchFiles(Path As String, FileType As String)
If kz Then Exit Function
    Dim Files()  As String '文件路径
    Dim Folder() As String '文件夹路径
    Dim a, b, c As Long
    Dim sPath As String
    On Error GoTo CheckError
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    sPath = Dir(Path & FileType) '查找第一个文件
    Do While Len(sPath) '循环到没有文件为止
        a = a + 1
        ReDim Preserve Files(1 To a)
        Files(a) = Path & sPath '将文件目录和文件名组合,并存放到数组中
        List1.AddItem Files(a) '加入list控件中
        sPath = Dir '查找下一个文件
        DoEvents '让出控制权
    Loop
    sPath = Dir(Path, vbDirectory)  '查找第一个文件夹
   
    Do While Len(sPath) '循环到没有文件夹为止
        If Left(sPath, 1) <> "." Then '为了防止重复查找
            If GetAttr(Path & sPath) And vbDirectory Then  '如果是文件夹则。。。。。。
                b = b + 1
                ReDim Preserve Folder(1 To b)
                Folder(b) = Path & sPath & "\" '将目录和文件夹名称组合形成新的目录,并存放到数组中
            End If
        End If
        sPath = Dir '查找下一个文件夹
        DoEvents '让出控制权
    Loop
CheckError:
    For c = 1 To b '使用递归方法，遍历所有目录
        SearchFiles Folder(c), FileType
    Next
End Function
Private Sub Command1_Click()
If Command1.Caption = "查找" Then
Command1.Caption = "停止"
kz = False
List1.Clear
SearchFiles Text1.Text, Text2.Text  '查找所有文件
Else
Command1.Caption = "查找"
kz = True
End If
End Sub
Private Sub Form_Load()
Text1.Text = "c:"
Text2.Text = "测试*.*"
End Sub

追问

没用

追答

第一个text填盘符或路径如D:
第二个填文件名如完整文件名 1.txt 模糊匹配 1*.*
确定你找的文件存在
不行就生成exe后右键点管理员运行