Read table metadata from a batch of MS-Access databases - vba

Question

I have 70+ Access databases in a directory. I think that some of them are forks of other databases in the same directory. A way to detect them is to check creation times of tables, but this way I need to open files and tables one by one and write down creation time.
Is there an easy way to automate this? Is there a way to read creation time of the tables of a batch of Access files?

Answer 1

You can use DAO to loop the TableDefs within a database, and get this information. Something like the below should get you started:
Sub sCheckAll(strPath As String)
On Error GoTo E_Handle
Dim strFile As String
strFile = Dir(strPath)
Do
If (Right(strFile, 3) = "mdb") Or (Right(strFile, 5) = "accdb") Then
Call sTableDefCreateTime(strPath & strFile)
End If
strFile = Dir
Loop Until strFile = ""
sExit:
On Error Resume Next
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sCheckAll", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Sub sTableDefCreateTime(strDBPath As String)
On Error GoTo E_Handle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = DBEngine(0).OpenDatabase(strDBPath)
For Each tdf In db.TableDefs
If Left(tdf.name, 4) <> "MSys" Then ' exclude system tables
Debug.Print tdf.name & vbTab & tdf.DateCreated & vbTab & tdf.Connect
End If
Next tdf
sExit:
On Error Resume Next
db.Close
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sTableDefCreateTime", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
It also gets the connection string, as some of the tables may be linked.
Regards,

Answer 2

Use following codes to get file names and created date of files from a directory. This will show result to a excel sheet like column File Name and column B Created Date.
Sub LoopThroughFiles()
Dim strDir As String
Dim StrFile As String
Dim i As Long
strDir = "D:\TEMP\"
i = 1
StrFile = Dir(strDir)
Do While Len(StrFile) > 0
Cells(i, 1) = StrFile
Cells(i, 2) = myMetaData(strDir & StrFile)
StrFile = Dir
i = i + 1
Loop
End Sub
Function myMetaData(CheckingFile As String)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(CheckingFile)
myMetaData = f.DateCreated
End Function