以下代码是搜索摸个文件夹以及下一层文件内的文件数量，能否改成只统计某个文件内的文件夹名字，并保存。

Dim searchingPath As String

Dim pl As Long
Dim finalOut As String
Dim c As Long

Private Sub cmdSave_Click()
    Open "c:\out.txt" For Output As #1
        Print #1, finalOut
    Close #1
    lblState.Caption = "保存完成! 已经写入到C:\Out.txt": DoEvents
End Sub

Private Sub cmdSearch_Click()
    c = 0
    If Right(txtDirPath.Text, 1) <> "\" Then txtDirPath.Text = txtDirPath.Text + "\"
    pl = Len(txtDirPath.Text)
    SearchFile txtDirPath.Text
End Sub

Private Sub Form_Load()
    Me.Show
    txtDirPath.SetFocus
    txtDirPath.SelStart = Len(txtDirPath.Text)
End Sub

Private Sub txtDirPath_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then cmdSearch_Click
End Sub

Sub SearchFile(strPath As String)
    On Error Resume Next
    Dim strName As String
    Dim dir_i() As String
    Dim i As Long, idir As Long
    Dim showStr As String
   
    If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
    strName = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
   
    Do While Len(strName) > 0
        If strName <> "." And strName <> ".." Then
            If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
                idir = idir + 1
                ReDim Preserve dir_i(idir) As String
                dir_i(idir - 1) = strName
            Else
                c = c + 1
                showStr = Replace(Mid(strPath, pl + 1), "\", "><")
                finalOut = finalOut + "<" + Left(showStr, Len(showStr) - 1) + strName + vbCrLf
            End If
        End If
        strName = Dir
       
        If searchingPath <> strPath Then
            lblState.Caption = "索引数: " & CStr(c) & "，搜索目录: " & strPath
            searchingPath = strPath
            DoEvents
        End If
    Loop
   
    For i = 0 To idir - 1
        Call SearchFile(strPath + dir_i(i))
    Next i
   
    Erase dir_i
   
    lblState.Caption = "搜索完成，总计文件数: " & CStr(c)
End Sub

谢谢版主这么块的速度
我刚刚在论坛找到了这个代码。

Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 255
cAlternate As String * 14
End Type

Private Sub cmdFindFiles_Click()
Dim wfd As WIN32_FIND_DATA
Dim isFindHandle As Long
Dim FileCount As Long
Dim Out As Long
Dim fileName As String
Out = True
isFindHandle = FindFirstFile("d:\vb源码\*", wfd)
If isFindHandle <> -1 Then

Do While Out
fileName = StripNulls(wfd.cFileName)

If fileName <> "." And fileName <> ".." Then
FileCount = FileCount + 1
List1.AddItem fileName
End If

Out = FindNextFile(isFindHandle, wfd)
Loop
End If

FindClose isFindHandle

MsgBox "D:\vb源码\中共有文件与文件夹数:" & FileCount
End Sub

Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

我主要是想将这个代码实现3个功能：
1、在List1里显示VB源码文件夹里各源码文件的名字。
2、双击所要打开的源码文件夹。
3、加一个查找文本框，可以根据输入的内容打开。

我相信有很多的新手都收集了很多的源码，在文件夹内一时半会找不到，通过读取-显示结果，选中-打开，这样来快速查找。


再次谢谢各位老师

在顶一 下！