【CBM666 的枚举子文件夹】

最新推荐文章于 2024-09-05 22:50:33 发布

cbm6666

最新推荐文章于 2024-09-05 22:50:33 发布

阅读量1k

点赞数

分类专栏： VB 专栏文章标签： command function string each

本文链接：https://blog.csdn.net/cbm666/article/details/2158251

版权

VB 专栏专栏收录该内容

11 篇文章 0 订阅

订阅专栏

'添加 Command1

Option Explicit
Dim strrec$(), TFolders&
Dim i&, fs, f, s

Private Sub Command1_Click()
   s = GetFolders("e:/music")
   If TFolders <= 0 Then MsgBox "无子文件夹": Exit Sub
   Me.Cls
   For i = 0 To UBound(s)
      Print s(i)
   Next i
   MsgBox "总共有: " & CStr(TFolders) & " 个子文件夹"
End Sub

Public Function GetFolders(Selpath$) As String()
   Set fs = CreateObject("Scripting.FileSystemObject")
   Selpath = IIf(Right(Selpath, 1) = "/", Mid(Selpath, 1, Len(Selpath) - 1), Selpath)
   Set f = fs.GetFolder(Selpath)
   ReDim Preserve strrec$(0)
   strrec(0) = Selpath
   TFolders = 0
   GetSubFolder f, 0
   GetFolders = strrec()
End Function

Private Sub GetSubFolder(f, n)
   Dim sf, f1
   Set sf = f.SubFolders
   If Not sf Is Nothing Then
      For Each f1 In sf
         GetSubFolder f1, n + 4
         TFolders = TFolders + 1
         ReDim Preserve strrec$(TFolders - 1)
         strrec(TFolders - 1) = f1
         DoEvents
      Next
   End If
End Sub