Public Sub ListFolders2()
Dim SH As Worksheet
Dim FSO As Object
Dim StartFolder As Object
Dim Fldr As Object
Dim iCtr As Long
Const sName As String = "Home"
Dim sStartDir As String

sStartDir = InputBox( _
Prompt:="Enter the initial directory", _
Default:="C:\")

On Error Resume Next
Set SH = Worksheets(sName)

Set FSO = CreateObject("Scripting.FileSystemObject")
Set StartFolder = FSO.GetFolder(sStartDir)
SH.Cells(1, "A").Value = sStartDir
For Each Fldr In StartFolder.SubFolders
iCtr = iCtr + 1
SH.Cells(iCtr + 1, "A").Value = Fldr.Name
Next Fldr

SH.Columns("A").AutoFit

Set SH = Nothing

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Norman Jones" wrote in message
...
Hi Cyzax,

Try
'=============
Public Sub ListFolders2()
Dim SH As Worksheet
Dim FSO As Object
Dim StartFolder As Object
Dim Fldr As Object
Dim iCtr As Long
Const sName As String = "Folder List"
Dim sStartDir As String

sStartDir = InputBox( _
Prompt:="Enter the initial directory", _
Default:="C:\")

On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(sName).Delete
Application.DisplayAlerts = True

Set SH = ThisWorkbook.Sheets. _
Add(after:=Sheets(Sheets.Count))
SH.Name = sName

Set FSO = CreateObject("Scripting.FileSystemObject")
Set StartFolder = FSO.GetFolder(sStartDir)
SH.Cells(1, "A").Value = sStartDir
For Each Fldr In StartFolder.SubFolders
iCtr = iCtr + 1
SH.Cells(iCtr + 1, "A").Value = Fldr.Name
Next Fldr

SH.Columns("A").AutoFit

End Sub
'<<=============


---
Regards,
Norman



"cyzax7 via OfficeKB.com" <u22797@uwe wrote in message
news:618029ac90469@uwe...
Hi,

In the code below, the directory is set in the macro. How should I make
the
macro read a user defined directory which is entered in excel.
What I mean is:

1. In the mainsheet (Excel), user will enter the directory for the
main_folder.

2.Then , once user click on the "Search" button, it will list all the
subfolder (from the main_folder directory) in the mainsheet at a
specified
row and column.Let say row 4, column "C".

Norman Jones wrote:
Hi Cyzax7,

Try:

'=============
Public Sub ListFolders()
Dim SH As Worksheet
Dim FSO As Object
Dim StartFolder As Object
Dim Fldr As Object
Dim iCtr As Long
Const sName As String = "Folder List"
Const sStartDir As String = "C\" '<<==== CHANGE

On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(sName).Delete
Application.DisplayAlerts = True

Set SH = ThisWorkbook.Sheets. _
Add(after:=Sheets(Sheets.Count))
SH.Name = sName

Set FSO = CreateObject("Scripting.FileSystemObject")
Set StartFolder = FSO.GetFolder("C:\")
SH.Cells(1, "A").Value = sStartDir
For Each Fldr In StartFolder.SubFolders
iCtr = iCtr + 1
SH.Cells(iCtr + 1, "A").Value = Fldr.Name
Next Fldr

SH.Columns("A").AutoFit

End Sub
'<<=============

---
Regards,
Norman

I have a main_folder (I name it as Folder_A) which contains many
subfolder
(Folder_1, Folder_2,Folder_3, ...Folder_n). where in each subfolder
[quoted text clipped - 9 lines]

I have tried so many ways, but it doesn't works.

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200606/1