I've been doing a lot of work on Access Database Migration lately and a question came up about how we could provide CM/QA level auditing of the current database. And that is what led me to coming up with the following bit of code attached to a little button in our new database.
Private Sub CMQA_Audit_Button_Click()
On Error GoTo Err_DocDatabase
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Set dbs = CurrentDB()
Dim OutDir As String
OutDir = CurrentProject.Path & "\" & Format(Now(), "ddmmmyy-hhmmss")
MkDir OutDir
Dim Tbl As TableDef
For Each Tbl In dbs.TableDefs\
If Tbl.Attributes = 0 Then ' Ignore System Tables
Application.ExportXML acExportTable, Tbl.Name, , OutDir & "\tbl_" & Tbl.Name & ".xsd"
End If
Next
Set cnt = dbs.Containers("Forms")
For Each doc In cnt.Documents
Application.SaveAsText acForm, doc.Name, OutDir & "\form_" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
Application.SaveAsText acReport, doc.Name, OutDir & "\rep_" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
Application.SaveAsText acMacro, doc.Name, OutDir & "\scr_" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
Application.SaveAsText acModule, doc.Name, OutDir & "\mod_" & doc.Name & ".txt"
Next doc
Dim QryAs QueryDef
For Each Qry In dbs.QueryDefs
If Not (Qry.Name Like "~sq_*") Then
Application.SaveAsText acQuery, Qry.Name, OutDir & "\qry_" & Qry.Name & ".txt"
End If
Next
Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing
Exit_DocDatabase:
Exit Sub
Err_DocDatabase:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DocDatabase
End Select
End Sub
I'm still not 100% happy with the output of the raw SQL code, but it does allow us to run Beyond Compare on the output and gives us all of the components (of our rather complex database) including VB Code, SQL and Form changes.
