Solved: Display folders in excel

[Ryu]

Hi guys

I was hoping someone could offer me some help please, what I want to do is pretty simple. I want to run a macro which will check a folder (the directory of the folder will never change) - I want to display each folder name in column A, if a folder has a sub folder/s then I want to display these in column B/C/D etc.

For example I have a folder called test in my douments, inside test there are folders called Audi, Ford, Golf, Honda, Toyota

Some of the folder above will have sub folders and others wont e.g Ford might have Focus, Mustang, Honda might have Civic, Jazz, Integra, Prelude and Toyota might have Celica, Supra.

Now when I run the macro I want to display the data as:

Column A.....Column B.....Column C.....Column D.....Column E.....Column F
Audi
Ford........Focus.....Mustang
Golf
Honda.....Civic.....Jazz.....Integra.....Prelude
Toyota.....Celica.....Supra

So basically I want to display the folder names of

C:\Documents and Settings\user1\My Documents\Test

Is this possible? Thanks

[stanl]

You could probably use the Shell... something like

pseudo-code

[vba]
objShell = CreateObject("Shell.Application")

cFolder = "C:\myfolder"
Folder = objShell.NameSpace(cFolder)
For Each Item In Folder.Items()
If Abs(Item.IsFolder) AND Item.Type = "File Folder" Then
'add folder name to Excel column
End If
Next

[/vba]

Stan

[Ryu]

Thanks Stani but what do you mean shell? Do I code it using visual basic editor in Excel?

Anyway after searching the web i got the following coding to work (partially)

Sub FindFiles()
Dim ws As Worksheet, fso As Object, fld As Object, rootfld As String, iStartRow As Long, iStartColumn As Long
Dim sNameMatch As String, bAddHyperlink As Boolean, bFullPath As Boolean
Application.ScreenUpdating = False
iStartRow = 2 ' Start list at row 2
iStartColumn = 1 ' List files and folders in column 'A'
Set ws = Worksheets("Sheet1")
'Set ws = ActiveSheet
sNameMatch = "ALL" ' List ALL files
'sNameMatch = "LookForFilesWithThisStringInTheName" ' List only the files with this string in the name
bAddHyperlink = False ' Add a hyperlink?
bFullPath = False ' Show the full path?
rootfld = "C:\Documents and Settings\user1\My Documents\Test\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(rootfld)
Call ListFiles(ProcessFolder:=fld, ListSheet:=ws, ListRow:=iStartRow, ListColumn:=iStartColumn, FileNameMatch:=sNameMatch, _
        AddHyperLink:=bAddHyperlink, ShowFullPath:=bFullPath)
'ws.Cells(1, 1).Select
Set fso = Nothing
Set fld = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub ListFiles(ProcessFolder As Object, ByRef ListSheet As Worksheet, ListRow As Long, ListColumn As Long, _
            FileNameMatch As String, AddHyperLink As Boolean, ShowFullPath As Boolean)
Dim fil As Object, subfld As Object
For Each fil In ProcessFolder.Files
    If InStr(fil.Name, FileNameMatch) <> 0 Or LCase(FileNameMatch) = "all" Then
        With ListSheet
            If ShowFullPath Then
                If AddHyperLink Then
                    .Hyperlinks.Add .Cells(ListRow, ListColumn), fil.path
                Else
                    .Cells(ListRow, ListColumn).Value = fil.path
                End If
            Else
                If AddHyperLink Then
                    .Hyperlinks.Add .Cells(ListRow, ListColumn), fil.path, , , fil.Name
                Else
                    .Cells(ListRow, ListColumn).Value = fil.Name
                End If
            End If
        End With
        ListRow = ListRow + 1
    End If
Next fil
For Each subfld In ProcessFolder.SubFolders
    With ListSheet
        If ShowFullPath Then
            If AddHyperLink Then
                .Hyperlinks.Add .Cells(ListRow, ListColumn), subfld.path
            Else
                .Cells(ListRow, ListColumn).Value = subfld.path
            End If
        Else
            If AddHyperLink Then
                .Hyperlinks.Add .Cells(ListRow, ListColumn), subfld.path, , , subfld.Name
            Else
                .Cells(ListRow, ListColumn).Value = subfld.Name
            End If
        End If
        ListRow = ListRow + 1
    End With
    Call ListFiles(ProcessFolder:=subfld, ListSheet:=ListSheet, ListRow:=ListRow, ListColumn:=ListColumn, _
            FileNameMatch:=FileNameMatch, AddHyperLink:=AddHyperLink, ShowFullPath:=ShowFullPath)
Next subfld
Set fil = Nothing
Set subfld = Nothing
End Sub

However there are two problems with the above coding:
1, It displays all files and folders when I only need the folders displayed and
2, It displays everything in Column A.

Any help please? Thanks

[GTO]

You may wish to study this work: http://vbaexpress.com/kb/getarticle.php?kb_id=405 by lucas; very good and I think adaptable to your needs.

Mark

[Ryu]

That site was really good and I got it to work, thanks

[GTO]

You bet Ryu,

Glad to be of some help in pointing towards a solution, but true "props" to lucas and his work.


Mark