如何批量查找已经文件名，并提取文件所在的路径？

seduse

请教一下各位高手，是否能批量查找已知文件名的在PC里面所储存的位置，并将位置信息提取到EXCEL中来。


文件名已知


这些在HJ文件夹内，有的在根目录下，有的在子目录下



是否有方法实现快速查找并提取文件所在路径，模拟效果如下图

ykcbf1100

附件供参考。。。

ykcbf1100

路径提取。。。

xlj310

ykcbf1100 发表于 2024-11-11 16:13
路径提取。。。

大佬，冒昧的问一下：查到以后，为何没有直接退出Sub呢，如果是只要查到就ok的话，应该直接退出效率会高很多吧？

ykcbf1100

xlj310 发表于 2024-11-12 09:06
大佬，冒昧的问一下：查到以后，为何没有直接退出Sub呢，如果是只要查到就ok的话，应该直接退出效率会高 ...

你说的也有道理。
不过，文件数量不太多时，时间相差无几。

MR_PP

xlj310 发表于 2024-11-12 09:06
大佬，冒昧的问一下：查到以后，为何没有直接退出Sub呢，如果是只要查到就ok的话，应该直接退出效率会高 ...

添加个标记就可以了。

ykcbf1100

MR_PP 发表于 2024-11-12 09:53
添加个标记就可以了。

搞复杂了，还不如4楼方案。

seduse

ykcbf1100 发表于 2024-11-11 16:12
附件供参考。。。

感谢大佬！代码我自己再慢慢琢磨琢磨，实在搞不懂的再来请教！
感谢！

seduse

ykcbf1100 发表于 2024-11-11 16:13
路径提取。。。

如果已知文件名，只知道文件名，不知道文件名后缀，这种情况还能实现读取路径么？

沧海一粟123123

Sub test()
Dim fu(1 To 1000)
Dim arr1(1 To 10000, 1 To 1)
Dim arr(1 To 10000, 1 To 1)
Dim f, i, j, k, f3, q

fu(1) = ThisWorkbook.Path & "\HJ\"
i = 1
k = 1
Do While i <= k
    f = Dir(fu(i), vbDirectory)
    Do
      If InStr(f, ".") = 0 And f <> "" Then
        k = k + 1
        fu(k) = fu(i) & f & "\"
      End If
      f = Dir
    Loop Until f = ""
    i = i + 1
Loop

For x = 1 To UBound(fu)
   If fu(x) = "" Then Exit For
   f3 = Dir(fu(x) & "*.*")
   Do While f3 <> ""
    q = q + 1
    arr1(q, 1) = fu(x) & f3
    arr(q, 1) = f3
    f3 = Dir
   Loop
Next x
Range("a2").Resize(q) = arr
Range("b2").Resize(q) = arr1
End Sub