【VBA】遍历文件夹下所有的文件夹名称

Option Explicit
Sub 提取文件夹名称()
Dim fs As Object
Dim f As Object
Dim fd As Object
Dim n As Integer
n = 2              '变量起始行
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder("C:\Users\合同\未整理")    '指定目录
For Each fd In f.subfolders
Cells(n, 2) = fd.Name
n = n + 1
Next
Set f = Nothing
Set fs = Nothing
End Sub