How to write directory structure to excel file
 

Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

Suyog,

Have a look at -

http://www.thescripts.com/forum/thread459690.html

Check the second last post on it. That code gives you all the
directories. You can probably change it to get the files as well.

Another way:

I have used the shell command to execute the Dos command dir

dim z as string
dim x as variant

'*****if your default windows directory is C:\windows***
z = "C:\windows\system32\cmd.exe " & " /c dir c:\mydir /a:d /b
/sdirs.txt"
x = shell(z)

that gives me all the subfolders from c:\mydir in the text file
dirs.txt along with the entire path. (This text file is created under
c:\mydir)

check the parameters of dir command by doing dir /? on the command
prompt. Set the appropriate parameters to get the file names as well.

I read the text file and put it into Excel.

HTH
-Satish

suyog_linux wrote:
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & _
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function


'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)
'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & _
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function


'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)
'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

It is code to put in an Excel VBA code module.

What do you mean by ...I copied this for a form under sub form_load() ?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
_
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function



'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)

'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

Hi Bob,

Can I know how can i put this code under Excel VBA code module.

I was thinking that this is a code for VB Applicaiotn so wrote about
from_load().

I am new to excel .. can you please help me.

Thanks,
Suyog

Bob Phillips wrote:
It is code to put in an Excel VBA code module.

What do you mean by ...I copied this for a form under sub form_load() ?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
_
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function



'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)

'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

From Excel, goto the VBIDE (Alt-F11)

Insert a code module (InsertModule)

Copy the code

From Excel, goto ToolsMacroMacros..., select the macro and hit run.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
ps.com...
Hi Bob,

Can I know how can i put this code under Excel VBA code module.

I was thinking that this is a code for VB Applicaiotn so wrote about
from_load().

I am new to excel .. can you please help me.

Thanks,
Suyog

Bob Phillips wrote:
It is code to put in an Excel VBA code module.

What do you mean by ...I copied this for a form under sub form_load() ?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""")
&
_
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function




'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)


'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path
from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

Hi Bob,

Thanks for reply.

When I run this code I get the information about Directories and sub
dir's but it does not list any files.

Moreover, I require the output in following form .....

Suppose .... I have a dir c:\code and it contains 1 file a.txt and one
sub-dir code1 .... code1 in turn contains 1 file b.txt.

I want output like

Column 1 Column2
a.txt c:\code
b.txt c:\code\code1

Thanks,
Suyog
Bob Phillips wrote:
From Excel, goto the VBIDE (Alt-F11)

Insert a code module (InsertModule)

Copy the code

From Excel, goto ToolsMacroMacros..., select the macro and hit run.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
ps.com...
Hi Bob,

Can I know how can i put this code under Excel VBA code module.

I was thinking that this is a code for VB Applicaiotn so wrote about
from_load().

I am new to excel .. can you please help me.

Thanks,
Suyog

Bob Phillips wrote:
It is code to put in an Excel VBA code module.

What do you mean by ...I copied this for a form under sub form_load() ?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""")
&
_
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function




'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)


'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path
from



root folder.


thanks,
Suyog

How to write directory structure to excel file
 

Try clicking on the outlining symbols(+) on the left of the rows.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
ups.com...
Hi Bob,

Thanks for reply.

When I run this code I get the information about Directories and sub
dir's but it does not list any files.

Moreover, I require the output in following form .....

Suppose .... I have a dir c:\code and it contains 1 file a.txt and one
sub-dir code1 .... code1 in turn contains 1 file b.txt.

I want output like

Column 1 Column2
a.txt c:\code
b.txt c:\code\code1

Thanks,
Suyog
Bob Phillips wrote:
From Excel, goto the VBIDE (Alt-F11)

Insert a code module (InsertModule)

Copy the code

From Excel, goto ToolsMacroMacros..., select the macro and hit run.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
ps.com...
Hi Bob,

Can I know how can i put this code under Excel VBA code module.

I was thinking that this is a code for VB Applicaiotn so wrote about
from_load().

I am new to excel .. can you please help me.

Thanks,
Suyog

Bob Phillips wrote:
It is code to put in an Excel VBA code module.

What do you mean by ...I copied this for a form under sub form_load() ?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi Bob,

Thank you very much for your reply.

I have few questions regarding this code.

1. Is this code for Script or Application?
2. I copied this for a form under sub form_load() but i am getting an
error at following line :
"ReDim Preserve arfiles(2, cnt)".
3. When I copied this an a html file and run I am getting an error at
following line :
"Private cnt As Long"

Please help.

Thanks,
Suyog

Bob Phillips wrote:
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

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

sFolder = "E:\"
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


#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter,
""",""")
&
_
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function





'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)



'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If





--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"suyog_linux" wrote in message
oups.com...
Hi All,

I would like to know how can i extract the whole path info of all
the files and subdirectories in a directory to a excel file.


Please help me with this.


e.g. I have following directory structure
c:\test contains 1 or more subdir and 1 or more files


Subdirs also contain files and subdirs ... i want info about all
this
when i enter param as c:\test ...


Column 1 should contain file name and column 2 should contain path
from



root folder.


thanks,
Suyog