I do this all the time.
In fact, I also have about 50+ dvd backups of my files over the years. It
was impossible to find anything on those data dvd (just the time for
the DVD drive to spool up each time I put a disk and was driving me crazy.
So I built a little archive application in MS access in which I inserted DVD
give the DVD an name, and all the directories are copied into a database
table in MS access along with the disk name.
Last time I looked I have well over 100,000 files in that directory
database, and I use this app at least once a week to look up and find some
old file that I had on my old laptop (my stack of archive dvd's actually
goes back two computers now....
I simply fire up the query builder to do wild card search for file names.
The basic code I use to "traverse" the file system is as follows:
Sub dirTest()
Dim dlist As New Collection
Dim startDir As String
Dim i As Integer
startDir = "C:\docs\"
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
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, vbNormal)
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 (GetAttr(startDir & strTemp) And vbDirectory) = vbDirectory Then
If (strTemp <> ".") And (strTemp <> "..") Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
' now process each folder (recursion)
For Each vFolderName In colFolders
Call FillDir(startDir & vFolderName & "\", dlist)
Next vFolderName
End Sub
To put the above data into a table, you go:
Dim cFiles As New Collection
Dim rst As DAO.Recordset
Dim i As Long
Call FillDir(Me.Text0, cFiles)
Set rst = CurrentDb.OpenRecordset("tblFiles")
For i = 1 To cFiles.Count
rst.AddNew
rst!DiskName = Me.txtdisk
rst!FileName = cFiles(i)
rst.Update
Next i
rst.Close
Set rst = Nothing
MsgBox "done"
In the above, me.txtDisk is a un-bound text box on the form that runs this
code, and is simply the name of the "disk" that given.
Interesting technique.
I've done it this way, just to get all the .mdbs on a directory tree.
Public Sub GetDIRs(Optional spath As String)
On Error Resume Next
Dim sFile As String
Dim sDirs() As String
Dim idxDirs As Integer
Dim idxProcessed As Integer
Dim IdxRecursed As Integer
If spath = "" Then
spath = BrowseFolder("Type the Path of the directory to scan")
End If
If spath = "" Then GoTo Exit_GetDirs:
If Right(spath, 1) <> "\" Then spath = spath & "\"
sFile = Dir(spath, vbDirectory)
ReDim Preserve sDirs(idxDirs)
sDirs(idxDirs) = spath
DoCmd.Hourglass True
Recurse:
Do While Len(Trim(sFile)) > 0
If sFile <> "." And sFile <> ".." Then
' Use bitwise comparison to make sure sFile is a directory.
If (GetAttr(spath & sFile) And vbDirectory) = vbDirectory Then
Debug.Print sFile
idxDirs = idxDirs + 1
ReDim Preserve sDirs(idxDirs)
sDirs(idxDirs) = spath & sFile & "\"
End If
End If
sFile = Dir
DoEvents
Loop
IdxRecursed = IdxRecursed + 1
If IdxRecursed <= idxDirs Then
spath = sDirs(IdxRecursed)
sFile = Dir(sDirs(IdxRecursed), vbDirectory)
GoTo Recurse:
Else
sFile = ""
End If
For idxProcessed = 0 To idxDirs
GetMDBs sDirs(idxProcessed)
Next
Exit_GetDirs:
Exit Sub
End Sub
Public Sub GetMDBs(Optional spath As String)
On Error Resume Next
Dim sFile As String
If Len(spath) = 0 Then
spath = BrowseFolder("Type the Path of the directory to scan")
End If
If spath = "" Then GoTo exit_GetMDBs:
If Right(spath, 1) <> "\" Then spath = spath & "\"
sFile = Dir(spath & "*.mdb")
DoCmd.Hourglass True
Do While Len(Trim(sFile)) > 0
GetQueries sFile, spath
getFields sFile, spath
sFile = Dir
Loop
DoCmd.Hourglass False
exit_GetMDBs:
Exit Sub
End Sub
