List of Directories

[jdrawmer]

Hey,

I'm sure i've done it before but i have no recollection of the answer - and would like some simplified code anyway...

I'm trying to populate drop down lists with the sub-directories names, of a specific directory.

So really, i just need the code for bringing up a list of directories

Thanks

 

[Fenrirshowl]

Here's a couple of bits of code (pretty much the same thing twice!) I used in excel to populate a dropdown box and a list box - it should point you in the right direction.

Private Sub load_ddbsubfolder(folderspec)
    ddbSubfolder.Clear
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.filesystemobject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    For Each f1 In fc
        ddbSubfolder.AddItem f1.Name
    Next
End Sub

Private Sub load_lbxfilelist(folderspec)
    Dim fs, f, f1, fc, s, ff
    On Error GoTo 500
    Set fs = CreateObject("scripting.filesystemobject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.Files
    lbxfilelist.Clear
    For Each f1 In fc
        lbxfilelist.AddItem f1.Name
    Next
500
End Sub

Fen

 

[jdrawmer]

thats brilliant, thanks a lot!

 

[jdrawmer]

infact, thinking into it a bit deeper, what i could do with, is the drop down list containing all sub-dir's of a directory, even sub-dirs of sub-dirs

e.g.

Input
Input/Drawings
Input/Pictures
Output
Output/SomethingElse
Output/SomethingElse/Again

Would the best way, be to create a function based on the above code, checking to see if there is any sub-dirs, and if there is, returning their names?

 

[Fenrirshowl]

If it's a drop down list you want I think I would stay with the macro rather than a function as you are building a list rather than wishing to return a given value.

You will need to set up a loop to run the same macro on all the subfolders & the subfolders of subfolders.

Here's a quick example that just lists the folders via msgbox that you can adapt to add the details to a drop down.

Sub load_ddbsubfolder()
    pathway = "C:\My Documents" 'hardcode or make an input, remember you might need to include the code to change directories
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.filesystemobject")
    Set f = fs.getfolder(pathway)
    Set fc = f.subfolders
    For Each f1 In fc
        MsgBox f1.Name
        load_ddbsubfolder2 (f & "\" & f1.Name)
    Next
End Sub

Private Sub load_ddbsubfolder2(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.filesystemobject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    For Each f1 In fc
        MsgBox f1.Name
        load_ddbsubfolder2 (folderspec & "\" & f1.Name)
    Next
End Sub

 

[jdrawmer]

thanks a lot. I thought it would be something along those lines, but thats great!

Jay

 

[Fenrirshowl]

You might want to look at the GetAbsolutePathName Method within the help files - could be useful to you.

 

[jdrawmer]

i might check that out, but for now its working perfectly as it is. Thanks a lot

 

[WinblowsME]

' Control Names:
'    ListBox        -> lstDirs
'    Command Button -> CommandButton1

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
   Dim ret As Double, path As String, file_name As String, line As String
   
   path = "C:\Documents and Settings\winblowsME\Desktop"
   file_name = "C:\Documents and Settings\winblowsME\Desktop\Temp_Subdirectories.txt"
   
   On Error Resume Next
   
   ret = Shell("Cmd.exe /c dir /ad /b /s " & Chr(34) & path & Chr(34) & " > " & Chr(34) & file_name & Chr(34), vbMinimizedNoFocus)
   
   Sleep (1000)
   
   Open file_name For Input As #1
      lstDirs.Clear
      
      Do While Not EOF(1)
         Line Input #1, line
         lstDirs.AddItem line
      Loop
   Close
   
   Kill file_name
End Sub