List Files Recursive by Allen Browne

[Guest]

http://allenbrowne.com/ser-59.html

Writing to a table
You could modify the code to write the files to a table. Create a table with
a text field to hold the file names. In the ListFiles() function,
OpenRecordset, and AddNew with Update as you loop through the items.

I was able to run the code in the immediate window, however when I ran the
code on the open form using the syntax: Call Listfiles ("C:\Tech Manuals" , ,
True, Me. 1stFileList) I get an error 2176 "The setting for this property is
too long.

However, I would prefer just writing the data to a table:

Table name = TItem
Field Name = Book (Note: I have the field set to 255 characters)

However, I have no Idea what I need to put in the module in the ListFiles ()
Function to make this happen. However I know from the code how to call the
function on a button on click event property. Call Listfiles ("C:\Tech
Manuals" , , True, Me. 1stFileList)

Any help would be greatly apprectiated from anybody because Im just learning
how to write functions.

Thanks,

 

[Albert D. Kallal]

How about this simple code:

Sub dirTest()

Dim dlist As New Collection
Dim startDir As String
Dim i As Integer

startDir = "C:\access\"
Call FillDir(startDir, dlist)

MsgBox "there are " & dlist.Count & " in the dir"

' lets printout the stuff into debug window for a test

For i = 1 To dlist.Count
Debug.Print dlist(i)
Next i

End Sub

the above does not put the results into a table..but uses a collection. You
could modify the above to
write out the data to a table.

The code to fill the above colleciton is quite short:


Sub FillDir(startDir As String, dlist As Collection)

' build up a list of files, and then
' add add to this list, any additinal
' folders

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

strTemp = Dir(startDir)

Do While strTemp <> ""
dlist.Add startDir & strTemp
strTemp = Dir
Loop

' now build a list of additional folders
strTemp = Dir(startDir & "*.", vbDirectory)

Do While strTemp <> ""
If (strTemp <> ".") And (strTemp <> "..") Then
colFolders.Add strTemp
End If
strTemp = Dir
Loop

' now process each folder (recursion)
For Each vFolderName In colFolders
Call FillDir(startDir & vFolderName & "\", dlist)
Next vFolderName

End Sub

that is all you need....

If you want to write out the data to a table then simply go

Sub dirTest()

Dim dlist As New Collection
Dim startDir As String
Dim i As Integer
dim rst as dao.recordset
startDir = "C:\access\"
Call FillDir(startDir, dlist)

MsgBox "there are " & dlist.Count & " in the dir"

' lets printout the stuff into debug window for a test

set rst = currentdb.openrecordSet("tblDir")

For i = 1 To dlist.Count
rst.AddNew
rst!DfileName = dlist(i)
rst.update
Next i

rst.close

End Sub


So, paste the above code samples into a standard module..and give it a
try...

 

[Guest]

I dont think this function also lists the sub directories and part of my
question was what code I needed to add to Mr. Brown's Function to write to a
table.

Thanks anyhow.

 

[Guest]

sorry, I didnt read your post completley through...However, I will give it a
whirl and see if it works..appreciate it and will let you know through this
post if it works....Thanks again and excuse my ignorance.

 

[Guest]

I tried the above new code above and I know within a doubt I am completly
hopless. Functions still kicking my butt.
Don't know if its my syntax modifying the functions or calling the functions.

I can give you an example how I want to set it up.

The directory is. C:\Tech manuals and it has sub directories under that also.

My table name in my access database is Named. Manuals
The 1st fields I have listed in my table is named: ManualID (primary Key)
The 2nd field I have listed in my table is named: Bookname

Now I want to set up a form called FBOOK and then put a command button on it
called populate. On the event click procedure I want to call the function
that will populate my table. From there I have know problem doing the other
fancy stuff.

I was using another function that was working great with MP3's or PDF's,
However the function didn't recognize and list .zip files. Mr. Allen
recomended me to his web site. I followed his example and it worked however
I wanted to pupulate a table vs a list box which it gave me some hope.

 

[Allen Browne]

Add the top of your procedure, open a recordset to append the items to:
Dim rs As DAO.Recordset
Set rs = dbEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset,
dbAppendOnly)

Inside the loop, where you have each item, add it to the table like this:
rs.AddNew
rs!Book = xxxx
rs.Update
(Replace the "xxxx" with whatever the value is you want in your field.)

At the end of the procedure, close the table again:
rs.Close
Set rs = Nothing

 

[Guest]

Thanks, Mr Brown I will give it a go.

Add the top of your procedure, open a recordset to append the items to:
Dim rs As DAO.Recordset
Set rs = dbEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset,
dbAppendOnly)

Inside the loop, where you have each item, add it to the table like this:
rs.AddNew
rs!Book = xxxx
rs.Update
(Replace the "xxxx" with whatever the value is you want in your field.)

At the end of the procedure, close the table again:
rs.Close
Set rs = Nothing

 

[Guest]

Well I at least got it to comile without errors...When I called the function
from a command button nothing happen and the table was empty.

Option Compare Database
'Dim rs As DAO.Recordset
'Set rs = DBEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset, dbAppendOnly)
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset, dbAppendOnly)

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir

rs.AddNew
rs!Book = 1111
rs.Update
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)
Next vFolderName

rs.Close
Set rs = Nothing
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function


I have no Idea going through the above code of even how it works' Since I
Have a better understanding of the other function in my previous post I
probebly should change them from a zip file to a rar. I will try and break
it down line by line..I may figure it out then. Thanks.

 

[Terry Kreft]

Could I suggest the following.

Amend Allens code as follows:-
'****************************************************
Public Function ListFiles(strPath As String, Optional strFileSpec As String,
_
Optional bIncludeSubfolders As Boolean, Optional lst As Object)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
If TypeOf lst Is DAO.Recordset Then
For Each varItem In colDirList
lst.AddNew
lst.Fields(0) = varItem
lst.Update
Next
ElseIf TypeOf lst Is Collection Then
For Each varItem In colDirList
lst.Add varItem
Next
ElseIf TypeOf lst Is ListBox Then
For Each varItem In colDirList
lst.AddItem varItem
Next
End If
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)
Next vFolderName
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

'****************************************************

You can then call the code like this
'****************************************************
Function testRs()
Dim strPath As String
Dim strFileSpec As String
Dim bIncludeSubfolders As Boolean

Dim d As DAO.Database
Dim c As DAO.Recordset
Dim i As Integer

strPath = "d:\home\"
strFileSpec = "*.*"
bIncludeSubfolders = True

Set d = CurrentDb

' Uncomment the following line if you want to empty the target table before
filling it again
' d.Execute "DELETE * FROM [TItem]"
Set c = d.OpenRecordset("SELECT [Book] FROM [TItem]", dbOpenDynaset)

Call ListFiles(strPath, strFileSpec, bIncludeSubfolders, c)

c.Close
Set c = Nothing
Set d = Nothing
End Function

'****************************************************

 

[Guest]

Haaalllllllaalllluuuuyaaa. It works. Thanks Mr. Allen and thanks Terry
Kreft for the
testrs function.

Mr. Allen it would be nice if you could include the function to populate the
table and how to call it like you did with the Immediate window and list
function. If you had a hit callendar to that link you would probable see
that over a 6 hour period I kept going back over the code and you
documentation. Remember Im not the only idiot out there..LOL.or maby I am.
After 3 days and about 4 hours total man hours trying to break it down not to
mention a 1000 brain cells. (dont have many left now) Im still trying to get
the hang of the different functions and how you guys seem to understand and
manipulate them in different ways. Been working with Access since 2.0 Have
everything else down pretty good or maby I think I do except for writing VBA
code. I would love to know what book you would recommend for me to get grasp
on at a minimum interpreting these functions in this newsgroup? We all
started sometime and hopefully one day instead of asking questions in this
newsgroup, I will be able to answer them as well.

Thanks again guys for your paitience.

Could I suggest the following.

Amend Allens code as follows:-
'****************************************************
Public Function ListFiles(strPath As String, Optional strFileSpec As String,
_
Optional bIncludeSubfolders As Boolean, Optional lst As Object)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
If TypeOf lst Is DAO.Recordset Then
For Each varItem In colDirList
lst.AddNew
lst.Fields(0) = varItem
lst.Update
Next
ElseIf TypeOf lst Is Collection Then
For Each varItem In colDirList
lst.Add varItem
Next
ElseIf TypeOf lst Is ListBox Then
For Each varItem In colDirList
lst.AddItem varItem
Next
End If
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)
Next vFolderName
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

'****************************************************

You can then call the code like this
'****************************************************
Function testRs()
Dim strPath As String
Dim strFileSpec As String
Dim bIncludeSubfolders As Boolean

Dim d As DAO.Database
Dim c As DAO.Recordset
Dim i As Integer

strPath = "d:\home\"
strFileSpec = "*.*"
bIncludeSubfolders = True

Set d = CurrentDb

' Uncomment the following line if you want to empty the target table before
filling it again
' d.Execute "DELETE * FROM [TItem]"
Set c = d.OpenRecordset("SELECT [Book] FROM [TItem]", dbOpenDynaset)

Call ListFiles(strPath, strFileSpec, bIncludeSubfolders, c)

c.Close
Set c = Nothing
Set d = Nothing
End Function

'****************************************************

--

Terry Kreft

Well I at least got it to comile without errors...When I called the function
from a command button nothing happen and the table was empty.

Option Compare Database
'Dim rs As DAO.Recordset
'Set rs = DBEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset, dbAppendOnly)
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant
Dim rs As DAO.Recordset
Set rs = DBEngine(0)(0).OpenRecordset("TItem", dbOpenDynaset, dbAppendOnly)

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir

rs.AddNew
rs!Book = 1111
rs.Update
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)
Next vFolderName

rs.Close
Set rs = Nothing
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function


I have no Idea going through the above code of even how it works' Since I
Have a better understanding of the other function in my previous post I
probebly should change them from a zip file to a rar. I will try and break
it down line by line..I may figure it out then. Thanks.