如何使用VB的FSO对象来遍历一个分区?或者整个硬盘?高分求助

Question

请教各位高手一个问题.如何使用VB的FSO对象来遍历一个分区?或者整个硬盘.我举个例子.下面的代码举例说明了如何获得一个 Files 集合，以及如何用 For Each...Next 语句来访问这个集合中的每个File：Sub ShowFolderList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 in fc
        s = s & f1.name 
        s = s & vbCrLf
    Next
    MsgBox s
End Sub下面是使用SUBFOLDERS集合.显示文件夹Sub ShowFolderList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    For Each f1 In fc
        s = s & f1.Name
        s = s & vbCrLf
    Next
    MsgBox s
End Sub
那么请问如何结合上面的例子来遍历一个分区或整个硬盘呢?
望高手不吝赐教,谢谢~~

Answer 1

Sub ShowFileList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 in fc
        s = s & f1.name 
        s = s & vbCrLf
    Next
    MsgBox s
End Sub
Sub ShowFolderList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    call ShowFileList(folderspec)
    Set fc = f.subfolders
    For Each f1 In fc
        showfolderlist(f1.name)
        s = s & f1.Name
        s = s & vbCrLf
    Next
    MsgBox s
End Sub
你直接调用showfolderlist就行了。

Answer 2

楼上速度真快。我已经用最快的速度写代码了:(
用递归遍历一个路径下的所有文件（包含子目录）。结果显示在立即窗口。Option Explicit
Dim DirectStore() As String
Private Sub FindFile(strPath As String)
    Dim StrCurPath As String, sPath As String
    Dim sFileName As String, sModel As String, sLocal As String
    Dim sDectory() As String  '当前目录子目录
    Dim intJlS As Integer, i As Integer
    Dim intTemp As Integer
    On Error GoTo ErrMsg
    
    intJlS = 0
    sPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
    
    intTemp = UBound(DirectStore)
    ReDim Preserve DirectStore(intTemp + 1)
    DirectStore(intTemp) = sPath
    
    sFileName = Dir(sPath, 31) 
    '31=vbNormal+vbReadOnly+vbHidden+vbSystem+vbVolume+vbDirectory
    Do While sFileName <> ""
        If sFileName <> "." And sFileName <> ".." Then
            '如果是目录保存到数组
            If GetAttr(sPath & sFileName) And vbDirectory Then
                intJlS = intJlS + 1
                ReDim Preserve sDectory(intJlS)
                sDectory(intJlS - 1) = sPath & sFileName
            Else
            End If
        End If
        sFileName = Dir
        Debug.Print strPath + sFileName
        DoEvents
    Loop
    
    '递归遍历    For i = 0 To UBound(sDectory, 1) - 1
        FindFile sDectory(i)
    Next    
    Exit Sub
ErrMsg:
    End SubPrivate Sub Command1_Click()
    FindFile "C:\EBGStock"
End SubPrivate Sub Form_Load()
    ReDim DirectStore(0)
End Sub