is there a simple excel vba program to list files on a local network, in all
sub folders from a given one, plus the following data for each file
(different colomns in each row for each file):
file name
file extention
date of creation
size
full path
Thanks
Rachel

Hi Rachel,

Not a simple function, but here is some VBA

Option Explicit


Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim 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

Set FSO = CreateObject("Scripting.FileSystemObject")

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

sFolder = "L:\Security"
ReDim arfiles(6, 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(6, i))
.Value = arfiles(5, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(6, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(5, i)
.Cells(i + 1, arfiles(6, i) + 1).Value = arfiles(1, i)
.Cells(i + 1, arfiles(6, i) + 2).Value = arfiles(2, i)
.Cells(i + 1, arfiles(6, i) + 3).Value = arfiles(3, i)
.Cells(i + 1, arfiles(6, i) + 4).Value = arfiles(4, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").Columns.AutoFit
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub


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

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

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(6, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = Right(oFile.Name, Len(oFile.Name) -
InStrRev(oFile.Name, "."))
arfiles(2, cnt) = Format(oFile.DateCreated, "dd mmm yyyy")
arfiles(3, cnt) = Format(oFile.Size, "#,##0")
arfiles(4, cnt) = oFile.Path
arfiles(5, cnt) = oFile.Name
arfiles(6, 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(sText As String, _
Optional sDelim As String = " ") As Variant
'-----------------------------*------------------------------*------
Dim i%, sFml$, v0, v1
Const sDQ$ = """"

If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next

Split = v0

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

"Rachel" wrote in message
...
is there a simple excel vba program to list files on a local network, in
all
sub folders from a given one, plus the following data for each file
(different colomns in each row for each file):
file name
file extention
date of creation
size
full path
Thanks
Rachel

Hi Bob,
Your code is much faster then the other codes available in this NG
which also uses FSO. But it seems to be quite complex. Can you pl
explain so that we can use it elsewhere in day to day works also.

Regards,

Bob Phillips wrote:
Hi Rachel,

Not a simple function, but here is some VBA

Option Explicit


Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim 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

Set FSO = CreateObject("Scripting.FileSystemObject")

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

sFolder = "L:\Security"
ReDim arfiles(6, 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(6, i))
.Value = arfiles(5, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(6,
i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(5, i)
.Cells(i + 1, arfiles(6, i) + 1).Value =
arfiles(1, i)
.Cells(i + 1, arfiles(6, i) + 2).Value =
arfiles(2, i)
.Cells(i + 1, arfiles(6, i) + 3).Value =
arfiles(3, i)
.Cells(i + 1, arfiles(6, i) + 4).Value =
arfiles(4, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").Columns.AutoFit
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub



'-----------------------------*------------------------------*------------
Sub SelectFiles(Optional sPath As String)

'-----------------------------*------------------------------*------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

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

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(6, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = Right(oFile.Name, Len(oFile.Name) -
InStrRev(oFile.Name, "."))
arfiles(2, cnt) = Format(oFile.DateCreated, "dd mmm yyyy")
arfiles(3, cnt) = Format(oFile.Size, "#,##0")
arfiles(4, cnt) = oFile.Path
arfiles(5, cnt) = oFile.Name
arfiles(6, 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(sText As String, _
Optional sDelim As String = " ") As Variant

'-----------------------------*------------------------------*------
Dim i%, sFml$, v0, v1
Const sDQ$ = """"

If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") &
"""}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next

Split = v0

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

"Rachel" wrote in message
...
is there a simple excel vba program to list files on a local
network, in
all
sub folders from a given one, plus the following data for each file
(different colomns in each row for each file):
file name
file extention
date of creation
size
full path
Thanks
Rachel

Hi Rachel,

I will outline the design first, and then you can come back and ask for more
detail on any particular sections

Main Routine
- creates a filesystemobject
- initialises the start folder
- calls the procedure SelectFiles which loads an array of files (see below)
- loops through the array to output details
- if the current item is the folder, not a file, just output name, else
hyperlink to name and output all other details

SelectFiles
- this is a recursive procedure, that is it calls itself, over and over
until it gets to the bottom level of a folder and its sub-folders
- process all files in the folder first, storing details in the array
- process any folders in this folder by calling SelectFiles for this folder
(the recursion)


Split and InstRev are general routines to emulate the Excel 2000 functions
in Excel 97.


--
HTH

Bob Phillips

"spareus" wrote in message
oups.com...
Hi Bob,
Your code is much faster then the other codes available in this NG
which also uses FSO. But it seems to be quite complex. Can you pl
explain so that we can use it elsewhere in day to day works also.

Regards,

Bob Phillips wrote:
Hi Rachel,

Not a simple function, but here is some VBA

Option Explicit


Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim 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

Set FSO = CreateObject("Scripting.FileSystemObject")

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

sFolder = "L:\Security"
ReDim arfiles(6, 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(6, i))
.Value = arfiles(5, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(6,
i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(5, i)
.Cells(i + 1, arfiles(6, i) + 1).Value =
arfiles(1, i)
.Cells(i + 1, arfiles(6, i) + 2).Value =
arfiles(2, i)
.Cells(i + 1, arfiles(6, i) + 3).Value =
arfiles(3, i)
.Cells(i + 1, arfiles(6, i) + 4).Value =
arfiles(4, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").Columns.AutoFit
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub



'-----------------------------*------------------------------*------------
Sub SelectFiles(Optional sPath As String)

'-----------------------------*------------------------------*------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

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

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(6, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = Right(oFile.Name, Len(oFile.Name) -
InStrRev(oFile.Name, "."))
arfiles(2, cnt) = Format(oFile.DateCreated, "dd mmm yyyy")
arfiles(3, cnt) = Format(oFile.Size, "#,##0")
arfiles(4, cnt) = oFile.Path
arfiles(5, cnt) = oFile.Name
arfiles(6, 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(sText As String, _
Optional sDelim As String = " ") As Variant

'-----------------------------*------------------------------*------
Dim i%, sFml$, v0, v1
Const sDQ$ = """"

If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") &
"""}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next

Split = v0

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

"Rachel" wrote in message
...
is there a simple excel vba program to list files on a local
network, in
all
sub folders from a given one, plus the following data for each file
(different colomns in each row for each file):
file name
file extention
date of creation
size
full path
Thanks
Rachel