VB icon

Access/MDB documentor

Email
Submitted on: 1/7/2015 10:51:00 AM
By: chris hankey (from psc cd)  
Level: Beginner
User Rating: By 10 Users
Compatibility: VB 3.0, VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0, VB Script, ASP (Active Server Pages)
Views: 666
 
     Excel macro that extracts all tables, fields, field types, queries & descriptions from a JET/Access database. Very useful for documenting Access databases.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Access/MDB documentor
' Description:Excel macro that extracts all tables, fields, field types, queries & descriptions from a JET/Access database.
Very useful for documenting Access databases.
' By: chris hankey (from psc cd)
'
' Inputs:msgbox will prompt for a path to the database.
'
' Returns:This code populates a spreadsheet with schema info.
'
' Assumes:This macro was developed with DAO 3.51, but should work with any of the later versions of DAO. It has not been tested with Access 2000. 
Paste the code into a module and make sure to set a reference to the DAO library.
'**************************************

Sub GetMDBDescription()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Creatorchris hankey
'Inputs none
'Returnsnone
'Created1/14/2000
'Modified
'Notes extracts all field and table descriptions from the database
'indicated by the user and loads them into the active sheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim sPath As String
Dim db As Database
Dim tdf As TableDef
Dim qdf As QueryDef
Dim fld As Field
Dim iRow As Integer
Dim sTemp As String
On Error GoTo ErrorHandler
'get the path of the mdb from the user
sPath = InputBox("Please enter the MDB's path")
'clear the sheets contents. Also removes all formatting
Cells.Delete
iRow = 1
'exit the sub if the user does not enter a path
If sPath <> vbNullString Then
'test the path to make sure that it actually points to a file
sPathTest = Dir(sPath, vbNormal)
Set db = OpenDatabase(sPath)
'format the sheet now that we have received a valid MDB
'to open
Columns("A:A").VerticalAlignment = xlTop
Columns("A:A").ColumnWidth = 36
Columns("B:B").VerticalAlignment = xlTop
Columns("B:B").WrapText = True
Columns("B:B").ColumnWidth = 26
Columns("D:D").VerticalAlignment = xlTop
Columns("D:D").WrapText = True
Columns("D:D").ColumnWidth = 43
ActiveSheet.Cells(iRow, 1) = "Tables"
ActiveSheet.Cells(iRow, 1).Font.Bold = True
ActiveSheet.Cells(iRow, 1).Font.Size = 12
iRow = iRow + 1
'scroll thru the tabledefs
For Each tdf In db.TableDefs
'skip Access System tables - they all start with MSys
If Left(tdf.Name, 4) <> "MSys" Then
ActiveSheet.Cells(iRow, 1) = tdf.Name
ActiveSheet.Cells(iRow, 1).Font.Bold = True
ActiveSheet.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
ActiveSheet.Cells(iRow, 2) = tdf.Properties("Description")
'merge the cells for the table descriptions
sTemp = "B" & iRow & ":D" & iRow
Range(sTemp).MergeCells = True
iRow = iRow + 1
'generate a header for the fields
ActiveSheet.Cells(iRow, 2) = "Field Name"
ActiveSheet.Cells(iRow, 2).Font.Bold = True
ActiveSheet.Cells(iRow, 2).Font.Underline = xlUnderlineStyleSingle
ActiveSheet.Cells(iRow, 3) = "Type"
ActiveSheet.Cells(iRow, 3).Font.Bold = True
ActiveSheet.Cells(iRow, 3).Font.Underline = xlUnderlineStyleSingle
ActiveSheet.Cells(iRow, 4) = "Description"
ActiveSheet.Cells(iRow, 2).Font.Bold = True
ActiveSheet.Cells(iRow, 4).Font.Underline = xlUnderlineStyleSingle
iRow = iRow + 1
'scroll thru the fields
For Each fld In tdf.Fields
ActiveSheet.Cells(iRow, 2) = fld.Name
ActiveSheet.Cells(iRow, 2).Font.Bold = True
ActiveSheet.Cells(iRow, 3) = TypeName(fld.Type)
ActiveSheet.Cells(iRow, 4) = fld.Properties("Description")
iRow = iRow + 1
Next fld
iRow = iRow + 1
End If
Next tdf
'generate a query section header
iRow = iRow + 1
ActiveSheet.Cells(iRow, 1) = "Queries"
ActiveSheet.Cells(iRow, 1).Font.Bold = True
ActiveSheet.Cells(iRow, 1).Font.Size = 12
'merge the cells for the Query descriptions
sTemp = "B" & iRow & ":D" & iRow
Range(sTemp).MergeCells = True
iRow = iRow + 1
'scroll thru the queries
For Each qdf In db.QueryDefs
ActiveSheet.Cells(iRow, 1) = qdf.Name
ActiveSheet.Cells(iRow, 1).Font.Bold = True
ActiveSheet.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
ActiveSheet.Cells(iRow, 4) = qdf.Properties("Description")
'merge the cells for the Query descriptions
sTemp = "B" & iRow & ":D" & iRow
Range(sTemp).MergeCells = True
iRow = iRow + 1
Next qdf
End If
ExitSub:
Exit Sub
ErrorHandler:
Select Case Err
Case 3270 'property not found
Resume Next
Case Else
MsgBox Err.Description
GoTo ExitSub
End Select
End Sub
Function TypeName(iType As Integer) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Creatorchris hankey
'Inputs iType - data type of field
'Returnsstring containing name of type
'Created1/14/2000
'Modified
'Notes
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case iType
Case dbBigInt
TypeName = "Big Integer"
Case dbBinary
TypeName = "Binary"
Case dbBoolean
TypeName = "Boolean"
Case dbByte
TypeName = "Byte"
Case dbChar
TypeName = "Char"
Case dbCurrency
TypeName = "Currency"
Case dbDate
TypeName = "Date"
Case dbDecimal
TypeName = "Decimal"
Case dbDouble
TypeName = "Double"
Case dbFloat
TypeName = "Float"
Case dbGUID
TypeName = "GUID"
Case dbInteger
TypeName = "Integer"
Case dbLong
TypeName = "Long"
Case dbLongBinary
TypeName = "Long Binary"
Case dbMemo
TypeName = "Memo"
Case dbNumeric
TypeName = "Numeric"
Case dbSingle
TypeName = "Single"
Case dbText
TypeName = "Text"
Case dbTime
TypeName = "Time"
Case dbTimeStamp
TypeName = "Time Stamp"
Case dbVarBinary
TypeName = "VarBinary"
Case Else
TypeName = ""
End Select
End Function


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.