我在Excel中尝试使用宏,但我无法得到我的确切要求。
例如:类别是文件夹名称。在这个类别中我有很多文件夹 的 AAA BBB CCC DDD EEE
如何在Excel中获得 AAA到EEE 。
答案 0 :(得分:0)
此代码将获取单元格A1中定义的路径内的每个文件夹的名称(例如C :)并将它们放在B列中:
Sub GetChildFolders()
Dim fso, categoryFolder, subFolder As Object
Dim i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set categoryFolder = fso.GetFolder(Cells(1, 1).Value)
i = 1
For Each subFolder In categoryFolder.subfolders
Cells(i, 2) = subFolder.Name
i = i + 1
Next subFolder
End Sub
Alterantively,您可以创建一个新的公式,返回带有文件夹的逗号分隔列表: (要创建新公式,请在VBA的窗口中从插入菜单添加新的模块)
Function GetChildFoldersList(ByVal path As String)
Dim fso, categoryFolder, subFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set categoryFolder = fso.GetFolder(path)
For Each subFolder In categoryFolder.subfolders
GetChildFoldersList = GetChildFoldersList + subFolder.Name + ", "
Next subFolder
If GetChildFoldersList > 0 Then
GetChildFoldersList = Left(GetChildFoldersList, Len(GetChildFoldersList) - 2)
Else
GetChildFoldersList = "Folder is Empty!"
End If
End Function
答案 1 :(得分:0)
这可以正确处理范围。
它并不假定SubFolders按字母顺序返回文件夹。 (documentation)中没有提到这样的事情。
'Add a reference to 'Microsoft Scripting Runtime' (Tools -> References...)
Function ChildFolders(path As String) As String
Dim fso As New Scripting.FileSystemObject
Dim fldr As Scripting.Folder
Set fldr = fso.GetFolder(path)
Dim minFolder As String, maxFolder As String
minFolder = ""
maxFolder = ""
Dim x As folder
For Each x In fldr.SubFolders
If x.Name < minFolder Or minFolder = "" Then
minFolder = x.Name
ElseIf x.Name > maxFolder Then
maxFolder = x.Name
End If
Next
Select Case True
Case minFolder = "" And maxFolder = ""
ChildFolders = "(No folders)"
Case maxFolder = ""
ChildFolders = minFolder
Case Else
ChildFolders = minFolder & " to " & maxFolder
End Select
End Function
答案 2 :(得分:-1)
将其粘贴到模块中以获取按名称列出的文件夹,在这种情况下,这些文件夹在桌面上。 -玩得开心
Sub ShowFolderList()
Dim fs, f, f1, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Users\Guest\Desktop\")
Set sf = f.Subfolders
r = 1
For Each f1 In sf
Cells(r, 1) = f1.Name
Cells(r, 1).WrapText = False
r = r + 1
Next
End Sub
!注意:打开Microsoft脚本运行时库。 !!