trishcollins
Board Regular
- Joined
- Jan 7, 2006
- Messages
- 71
Okay, I have managed to almost get this cracked, but currently I am only getting the immediate subfolder names. I am trying to figure out how to get all the subfolder and their subfolder names into a list, so it can be used in a drop down menu on another sheet, so someone can generate a list of files names on that specific subfolder (that is already working, but I want the drop down menu to allow them to "pick" the subfolder name rather than type it in a make mistakes).
Here is the result of the current macro. As you can see each corresponding table only contains the root list of subfolders. The code takes the table on the far left ("EA_Libraries_Data") which contains a list of the other three tables in the first column and the mapped drive for each in the second column, and puts them into an array, then runs through the array, populating the respective table using the mapped drive. I am just missing a loop to get it to go into further subfolders, but can't figure it out. I feel I need to append each subfolder name it finds to MyArrayDir and then run the loop again, but can't figure out the code to do that.
Here is the code:
Here is the result of the current macro. As you can see each corresponding table only contains the root list of subfolders. The code takes the table on the far left ("EA_Libraries_Data") which contains a list of the other three tables in the first column and the mapped drive for each in the second column, and puts them into an array, then runs through the array, populating the respective table using the mapped drive. I am just missing a loop to get it to go into further subfolders, but can't figure it out. I feel I need to append each subfolder name it finds to MyArrayDir and then run the loop again, but can't figure out the code to do that.
Here is the code:
Code:
Sub ListMyDir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
Application.StatusBar = "Importing Beehive Directories"
Dim tblrow As Integer
Dim myTable As ListObject
Dim MyArray As Variant
Dim MyArrayTable As String
Dim MyArrayDir As String
Dim x As Integer
Set myTable = ActiveSheet.ListObjects("EA_Libraries_Data")
MyArray = myTable.DataBodyRange
On Error Resume Next
[B] For x = 1 To 3
tblrow = 1
MyArrayTable = MyArray(x, 1)
MyArrayDir = MyArray(x, 2)
ActiveSheet.ListObjects(MyArrayTable).DataBodyRange.Delete
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(MyArrayDir)
On Error Resume Next
For Each MySubfolder In mySource.SubFolders
ActiveSheet.ListObjects(MyArrayTable).ListRows.Add AlwaysInsert:=True
ActiveSheet.ListObjects(MyArrayTable).DataBodyRange(tblrow, 1).Value = MySubfolder
tblrow = tblrow + 1
Next
Next x[/B]
End Sub
Last edited: