I have multiple folders containing multiple files & subfolders inside.
Is it possible for me import the path's of all the files & subfolders in an
excel sheet.
eg. I have 20 files and 5 folders in "My documents"
i need the exact path of the 20 files in different cells of excel + same
with the files in the 5 subfolders

It is quite difficult to do see properties for each file and insert it in
the cell.

This will create a hyperlinked list

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
Dim oWSH As Object

arfiles = Array()
cnt = -1
level = 1

Set oWSH = CreateObject("WScript.Shell")
sFolder = oWSH.SpecialFolders(16)
set oWSH = Nothing

ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Techno" wrote in message
...
I have multiple folders containing multiple files & subfolders inside.
Is it possible for me import the path's of all the files & subfolders in
an
excel sheet.
eg. I have 20 files and 5 folders in "My documents"
i need the exact path of the 20 files in different cells of excel + same
with the files in the 5 subfolders

It is quite difficult to do see properties for each file and insert it in
the cell.

Try the free Excel add-in "List Files".
Download from ... http://www.realezsites.com/bus/primitivesoftware
no registration required.
--
Jim Cone
San Francisco, USA


"Techno"
wrote in message
I have multiple folders containing multiple files & subfolders inside.
Is it possible for me import the path's of all the files & subfolders in an
excel sheet.
eg. I have 20 files and 5 folders in "My documents"
i need the exact path of the 20 files in different cells of excel + same
with the files in the 5 subfolders

It is quite difficult to do see properties for each file and insert it in
the cell.

Hi Bob,
Thanks a lot for your reply ..but where do I put the thing ?
am a very new excel user..
Would really appreciate ur help
Udhit

"Bob Phillips" wrote:

This will create a hyperlinked list

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
Dim oWSH As Object

arfiles = Array()
cnt = -1
level = 1

Set oWSH = CreateObject("WScript.Shell")
sFolder = oWSH.SpecialFolders(16)
set oWSH = Nothing

ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Techno" wrote in message
...
I have multiple folders containing multiple files & subfolders inside.
Is it possible for me import the path's of all the files & subfolders in
an
excel sheet.
eg. I have 20 files and 5 folders in "My documents"
i need the exact path of the 20 files in different cells of excel + same
with the files in the 5 subfolders

It is quite difficult to do see properties for each file and insert it in
the cell.

If you don't want to do it yourself, then the free Excel add-in "List Files"
should do what you want. Download from ...
http://www.realezsites.com/bus/primitivesoftware
No registration required.
--
Jim Cone
San Francisco, USA



"Techno"
wrote in message
Hi Bob,
Thanks a lot for your reply ..but where do I put the thing ?
am a very new excel user..
Would really appreciate ur help
Udhit

Go to the VBIDE, Alt-F11, insert a code module, InsertModule, and paste the
code in.

Then goto Excel, ToolsMacroMacros..., select Folders from the list and Run
it

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Techno" wrote in message
...
Hi Bob,
Thanks a lot for your reply ..but where do I put the thing ?
am a very new excel user..
Would really appreciate ur help
Udhit

"Bob Phillips" wrote:

This will create a hyperlinked list

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
Dim oWSH As Object

arfiles = Array()
cnt = -1
level = 1

Set oWSH = CreateObject("WScript.Shell")
sFolder = oWSH.SpecialFolders(16)
set oWSH = Nothing

ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)),
_
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Techno" wrote in message
...
I have multiple folders containing multiple files & subfolders inside.
Is it possible for me import the path's of all the files & subfolders
in
an
excel sheet.
eg. I have 20 files and 5 folders in "My documents"
i need the exact path of the 20 files in different cells of excel +
same
with the files in the 5 subfolders

It is quite difficult to do see properties for each file and insert it
in
the cell.