Looping Through Directories and Database Files 1

[Knicks]

I have code that works great for determining Access file version information per directory that is entered by as a string, yielding the required information for each database file in a particular directory.

I was wondering if the code could be altered to start at a directory and move through sub directories also. So instead of just finding all database files in \\server\databases\ it would continue until no sub folders exist, so typing in \\server\databases would show all database file information for that directory but would continue on to any subsequent folders that may or may not exist..


CreateMDBtable(Spath As String)

Dim Readdb As DAO.Database
Dim dbs As DAO.Database
Dim TsRec As DAO.Recordset
Dim dbreadname As String
Dim SnextFile As String
Dim fullpath As String


Set dbs = currentDb
Set TsRec = dbs.OpenRecordset("tblfiles", dbOpenDynaset)

SnextFile = Dir$(Spath & "\*.md*")



While SnextFile <> ""

fullpath = "" & Spath & SnextFile & ""
Debug.Print fullpath
Set Readdb = OpenDatabase(fullpath)



TsRec.AddNew
TsRec!fname = SnextFile
TsRec!fpath = Spath
TsRec!fversion = Readdb.Properties("accessversion").Value
TsRec!Fsize = FileLen(Readdb.Name)
TsRec!Flastdate = FileDateTime(Readdb.Name)
TsRec.Update
SnextFile = Dir$


Readdb.Close
Wend

TsRec.Close



End Sub

 

[Golom]

The Dir function is global in the sense that

Folder = Dir ("C:\myFolder", vbDirectory)
Do Until Folder = ""
   ' Some Code
   Folder = Dir()
Loop

works fine but

Folder = Dir ("C:\myFolder", vbDirectory)
Do Until Folder = ""
   SubFolder = Dir(Folder)
   Do Until SubFolder = ""
      ' Some Code
      SubFolder = Dir()
   Loop
   Folder = Dir()
Loop

Does not work because the second reference to "Folder = Dir()" no longer refers to the containing directory.

You will need to go to a FileSystemObject model to do this

Public Sub LoadFiles(Spath As String)
Dim FSO As New FileSystemObject
Dim fdr As Scripting.folder
Dim fil As Scripting.File

Set fdr = FSO.GetFolder(Spath)
For Each fdr In FSO.GetFolder(Spath)
   For Each Fil In fdr.Files
      If Fil.Name Like *.md*" Then
         [COLOR=black cyan]' Do your recordset stuff[/color]
      End If
   Next Fil
   LoadFiles(Fdr.Name) [COLOR=black cyan]' Recursive Call[/color]
Next
End Sub

 

[Knicks]

Thank you! I have started to set the code and it does not compile. The first line with FSO, gets a user defined type not defined.

Public Sub LoadFiles()
Dim FSO As New FileSystemObject
Dim fdr As Scripting.folder
Dim fil As Scripting.File

Dim Readdb As DAO.Database
Dim dbs As DAO.Database
Dim TsRec As DAO.Recordset

Dim dbreadname As String
Dim SnextFile As String
Dim fullpath As String

Set dbs = currentDb
Set TsRec = dbs.OpenRecordset("tblfiles", dbOpenDynaset)


Set fdr = FSO.GetFolder(Spath)
For Each fdr In FSO.GetFolder(Spath)
For Each fil In fdr.Files
If fil.Name Like "*.md*" Then
' Do your recordset stuff

Set Readdb = OpenDatabase(fil.Name)

TsRec.AddNew
TsRec!fname = SnextFile
TsRec!fpath = Spath
TsRec!fversion = Readdb.Properties("accessversion").Value
TsRec!Fsize = FileLen(Readdb.Name)
TsRec!Flastdate = FileDateTime(Readdb.Name)
TsRec.Update
SnextFile = Dir$


Readdb.Close


End If
Next fil
LoadFiles (fdr.Name) ' Recursive Call
Next

TsRec.Close

End Sub

 

[PaulBricker]

You need to set the Microsoft Scription Runtime library in your References.

On the menu bar

Tools...References and then scroll down and check the box for
Microsoft Scription Runtime


Paul

 

[PHV]

You may try this:

Public Sub LoadFiles(Spath As String)
Dim FSO As Object, fdr As Object, fil As Object, sfdr As Object
Dim Readdb As DAO.Database
Dim dbs As DAO.Database
Dim TsRec As DAO.Recordset
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fdr = FSO.GetFolder(Spath)
Set dbs = CurrentDb
Set TsRec = dbs.OpenRecordset("tblfiles", dbOpenDynaset)
With TsRec
  For Each fil In fdr.Files
    If fil.Name Like "*.md*" Then
      Set Readdb = OpenDatabase(fil.path)
      .AddNew
      !fname = fil.Name
      !fpath = Spath
      !fversion = Readdb.Properties("accessversion").Value
      !Fsize = FileLen(Readdb.Name)
      !Flastdate = FileDateTime(Readdb.Name)
      .Update
      Readdb.Close
      Set Readdb = Nothing
    End If
  Next
  .Close
End With
Set TsRec = Nothing
For Each sfdr In fdr.SubFolders
  LoadFiles (sfdr.path)    ' Recursive Call
Next
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Knicks]

Thank you Paul!

That cleared the compiling problem. Now when I run it I get a Run-Time error 438, object doesnt' support this property or method on this line:

For Each fdr In FSO.GetFolder(Spath)



Public Sub LoadFiles(Spath As String)
Dim FSO As New FileSystemObject
Dim fdr As Scripting.folder
Dim fil As Scripting.File

Dim Readdb As DAO.Database
Dim dbs As DAO.Database
Dim TsRec As DAO.Recordset


Dim SnextFile As String
Dim fullpath As String



Set dbs = currentDb
Set TsRec = dbs.OpenRecordset("tblfiles", dbOpenDynaset)


Set fdr = FSO.GetFolder(Spath)
For Each fdr In FSO.GetFolder(Spath)
For Each fil In fdr.Files
If fil.Name Like "*.md*" Then
' Do your recordset stuff

Set Readdb = OpenDatabase(fil.Name)
'Set dbreadname = fil.Name

'Set fullpath = FSO.getfolder(Spath)


TsRec.AddNew
TsRec!fname = fil.Name
TsRec!fpath = FSO.GetFolder(Spath)
TsRec!fversion = Readdb.Properties("accessversion").Value
TsRec!Fsize = FileLen(Readdb.Name)
TsRec!Flastdate = FileDateTime(Readdb.Name)
TsRec.Update
SnextFile = Dir$


Readdb.Close


End If
Next fil
LoadFiles (fdr.Name) ' Recursive Call
Next

TsRec.Close

End Sub

 

[PHV]

Did you try my suggestion ?

 

[Knicks]

PHV,

You rock! Works like a charm. Thank you all very much really appreciate the expert help.