VB读取C:尀1尀下所有以数字命名的文件夹的名称并显示在listbox里

Private Sub Command1_Click()
get_folders List1, "C:\1\"
End Sub
Private Sub get_folders(ByRef List1 As ListBox, ByVal path As String)
Dim fso As New Scripting.FileSystemObject
Dim fd As Scripting.Folder
Dim fd_1 As Scripting.Folder
Set fd = fso.GetFolder(path)
For Each fd_1 In fd.SubFolders
If IsNumeric(FindStr(fd_1.path, "\")) Then
List1.AddItem fd_1.path
End If
Next
End Sub

Public Function FindStr(ByVal vSourceStr As String, Optional ByVal vsStr As String, Optional ByVal veStr As String) As String
Dim sourceStr, sourceStrtemp, sourceStrtemp2, sStr, eStr, S, E, opStr
sourceStr = vSourceStr
sStr = vsStr
eStr = veStr
For i = Len(sourceStr) To 1 Step -1
sourceStrtemp = sourceStrtemp & Mid$(sourceStr, i, 1)
Next
For i = Len(sStr) To 1 Step -1
sourceStrtemp2 = sourceStrtemp2 & Mid$(sStr, i, 1)
Next
S = InStr(sourceStrtemp, sourceStrtemp2)
If S <> 0 Then
sourceStrtemp = Mid$(sourceStrtemp, 1, S - 1)
sourceStrtemp2 = ""
For i = Len(sourceStrtemp) To 1 Step -1
sourceStrtemp2 = sourceStrtemp2 & Mid$(sourceStrtemp, i, 1)
Next
FindStr = sourceStrtemp2
Else
FindStr = ""
End If
End Function

注意:
控件 一个列表 一个按键
工程 > 引用 Microsoft Scripting Runtime

新建工程 ,一个按钮,一个listbox

Private WithEvents a As DirListBox

Private Sub Command1_Click()
Set a = Controls.Add("VB.dirListBox", "Dir1")
With a
.Visible = False
.Path = "c:\1\"
End With
List1.Clear
For i = 0 To a.ListCount - 1
b = Right(a.List(i), Len(a.List(i)) - Len("c:\1\"))
If IsNumeric(b) Then List1.AddItem b
Next
End Sub