Question

请问如何通过VB遍历全盘查找文件的位置？

我想在所有盘符（不固定）下查找名为“**.xlt”的文件。结果可能有一个也有可能多个。然后把这些查到的地址赋到字符数组中去。应该如何去写？
能给个现成的吗（能用的）？我急用。谢谢！

Answer 1

Option Explicit
'添加两个按钮，一个label一个listbox，然后粘贴如下代码，我这里把结果保存到listbox里的，而不是数组里，如果你需要的话，百度HI我我给你改一下
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6

Private StopFlag As Boolean

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub FileSearch(ByVal sPath As String, ByVal Filter As String)
Static lngFiles As Long
Dim sDir As String
Dim sSubDirs() As String
Dim lngIndex As Long
Dim lngTemp&
Dim sFilter() As String
Dim lngFilterIndex As Long
Dim bDirFlags As Boolean
sFilter = Split(Filter, ",")

DoEvents
If StopFlag = True Then Exit Sub

Label1.Caption = "当前路径" & sPath
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

For lngFilterIndex = LBound(sFilter) To UBound(sFilter)
sDir = Dir(sPath & sFilter(lngFilterIndex))
Do While Len(sDir)
lngFiles = lngFiles + 1
List1.AddItem sPath & "\" & sDir
sDir = Dir
Loop
Next

lngIndex = 0
sDir = Dir(sPath & "*.*", vbDirectory)
Do While Len(sDir)
If Left(sDir, 1) <> "." And Left(sDir, 1) <> ".." Then
On Error Resume Next
bDirFlags = False
bDirFlags = GetAttr(sPath & sDir) And vbDirectory
If bDirFlags = True Then
lngIndex = lngIndex + 1
ReDim Preserve sSubDirs(1 To lngIndex)
sSubDirs(lngIndex) = sPath & sDir & "\"
DoEvents
End If
On Error GoTo 0
End If
sDir = Dir
Loop
For lngTemp = 1 To lngIndex
Call FileSearch(sSubDirs(lngTemp), Filter)
Next lngTemp
End Sub
Public Sub StartSearch(ByVal Filter As String)
Dim nType As Long, s As String, sDrive As String, d As String
Dim pos As Integer
s = String(256, Chr(0))
GetLogicalDriveStrings Len(s), s
Do
pos = InStr(s, Chr(0))
sDrive = Left(s, pos - 1)
If Len(sDrive) = 0 Then Exit Do
s = Mid(s, pos + 1)
nType = GetDriveType(sDrive)
If nType = DRIVE_FIXED Then
d = Left(sDrive, 2) & "\"
FileSearch d, Filter
End If
Loop Until pos <= 0
End Sub

Private Sub Command1_Click() '测试
StartSearch "*.txt"
End Sub

Private Sub Command2_Click()
StopFlag = True
End Sub
Private Sub Form_Initialize()
Me.Left = Screen.Width / 2 - Me.Width / 2
Me.Top = Screen.Height / 2 - Me.Height / 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Answer 2

网络资料好多，不过都是嫡归的

Answer 3

你先用 Chdir 命令切换到相应目录，再引用 DOS 里的 dir/s 命令，就可以在该目录下查找文件。

最好做个 .bat 的批处理文件，然后在 VB 里引用。

希望对你有帮助。

Answer 4

递归
如果静态数组没有办法定义大小
动态数组得反复几遍，性能大幅下降
用fso看看