Click here to Skip to main content
15,888,351 members
Search within:


Articles / Programming Languages / VBScript
 
Tip/Trick

Generating Data Dictionary or Database Design Document using MS Word Macros

Rate me:
Please Sign up or sign in to vote.
3.58/5 (10 votes)
31 Mar 2008CPOL2 min read 73.8K   1.6K   17   14
Generating Data Dictionary or Database Design Document using MS Word macros.

Introduction

Manually preparing a data dictionary document will take ages in MS Word which contains 100's of tables, stored procedures, functions, triggers, views, indexes, etc. in a SQL Server database as you need to type each and every column of the table along with the associated dependencies. I need a data dictionary document which generates the database schema automatically in one click with nice formatting. For this I did a lot of research in Google to find the solution and finally I wrote my own code to do this functionality and I thought to share my experience with you all.

The main purpose of this article is to generate the data dictionary document automatically by simply running the macro code in MS Word within seconds.

I am not a VBA guru but I still started doing some kind of researching on VBA code in Google and I got ideas from different forums, many thanks to those people who posted their ideas.

I hope this solution will help you to prepare a data dictionary document. Here we start...

Basically, this code will prepare for you the following information in the document. The table name with the following dependent information:

  • Table Column Details
  • Indexes
  • Views
  • Stored Procedures
  • Functions
  • Triggers
  • Primary Keys
  • Foreign Keys
  • Default Constraints
  • Identity Columns

Using the code

Following are the steps to run this code:

  1. Simply open a blank Word document (it is mandatory).
  2. Go to menu Tools->Macro->Macros->Create, this will create a new Visual Basic module editor.
  3. Paste this code.
  4. Change the connection string as per your SQL Server credentials (it is mandatory).
  5. Add references to Microsoft ActiveX Data Objects Library from the menu Tools->References.
  6. Run the macro by pressing F5 from the VBA editor.

data_dictionary/document_template.jpg

Points of Interest

This code will generate the data dictionary document automatically with one click and it is simple to use this code.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Shashidhar Rao Nellutla
Software Developer (Senior)
United Kingdom United Kingdom
Completed Masters in Computer Applications.

Comments and Discussions

 
First Prev Next
Questionit works but it did not get stored procedures Pin
Member 1198044513-Sep-15 5:34
Member 1198044513-Sep-15 5:34 
QuestionI modified a Pk problem, i ran this in SQL Server 2014 and Works ok. Pin
Pavel Flores29-Jul-15 14:53
Pavel Flores29-Jul-15 14:53 
QuestionEdit macro for Description it's not coming in Origiranl Pin
Member 111947325-Nov-14 2:14
Member 111947325-Nov-14 2:14 
Sub Test()

End Sub



Sub About()

'
' Macro created 3/18/2008 by shashi
'
Dim conn As New ADODB.Connection
Dim rsMain As New ADODB.Recordset
Dim rsFields As New ADODB.Recordset
Dim rsKey As New ADODB.Recordset
Dim rsKeyTemp As ADODB.Recordset
Dim Range As Range
Dim row As Integer
Dim strQuery As String
Dim strFieldType As String
Dim I As Long
Dim rscount As Integer

'Open a connection object
If conn.State = 1 Then conn.Close
conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=Advance@01;Initial Catalog=BEBetaDevelopment1.0;Data Source=EI2K8R2VM-7"

'Open the recordset to retrieve the tables in the database
If rsMain.State = 1 Then rsMain.Close
rsMain.Open "Select top 5 * from sys.tables order by name", conn, adOpenKeyset, adLockOptimistic

row = 1
'Iterate through the tables recordset
While Not rsMain.EOF
'Start with the active document
With Word.ActiveDocument
'Procedure to set the table name
Call SetTableName(rsMain(0))

'Query to get the Indexes,Views,Stored Procedures,Functions,Triggers of the table

strQuery = "select ind.name,'INDEX' as col2 from sys.indexes ind inner join sys.tables tab" & _
" on ind.object_id = tab.object_id where tab.name = '" & rsMain(0) & "'" & _
" and ind.name is not null" & _
" union" & _
" Select Distinct Procedures.Name, 'View' as col2 From SysObjects" & _
" Join (SysObjects Procedures Join SysDepends on Procedures.Id = SysDepends.Id)" & _
" On SysDepends.DepId = SysObjects.Id Where SysObjects.XType = 'U'" & _
" And Procedures.XType = 'V' And SysObjects.Name = '" & rsMain(0) & "'" & _
" union" & _
" Select Distinct Procedures.Name, 'Stored Procedure' as col2 From SysObjects" & _
" Join (SysObjects Procedures Join SysDepends on Procedures.Id = SysDepends.Id)" & _
" On SysDepends.DepId = SysObjects.Id Where SysObjects.XType = 'U'" & _
" And Procedures.XType = 'P'And SysObjects.Name = '" & rsMain(0) & "'" & _
" AND (lower(Procedures.Name) like 'spalias%' or lower(Procedures.Name) like 'spcustom%' " & _
" or lower(Procedures.Name) like 'spncustom%') " & _
" union" & _
" Select Distinct Procedures.Name, 'Function' as col2 From SysObjects" & _
" Join (SysObjects Procedures Join SysDepends on Procedures.Id = SysDepends.Id)" & _
" On SysDepends.DepId = SysObjects.Id Where SysObjects.XType = 'U'" & _
" And Procedures.XType in ( 'Fn','If','Tf') And SysObjects.Name = '" & rsMain(0) & "'" & _
" union" & _
" Select Distinct Procedures.Name, 'Trigger' as col2 From SysObjects" & _
" Join (SysObjects Procedures Join SysDepends on Procedures.Id = SysDepends.Id)" & _
" On SysDepends.DepId = SysObjects.Id Where SysObjects.XType = 'U'" & _
" And Procedures.XType = 'Tr' And SysObjects.Name = '" & rsMain(0) & "'"

'Create a recordset to find Indexes,Views,Stored Procedures,Functions,Triggers of the table
If rsKey.State = 1 Then rsKey.Close
rsKey.Open strQuery, conn, adOpenKeyset, adLockReadOnly


'***************Index************************
If Not rsKey Is Nothing Then
'Clone the recordset object to find the indexes of the table
Set rsKeyTemp = rsKey.Clone(adLockReadOnly)
rsKeyTemp.Filter = "col2='INDEX'"
'Set the labelling in the document
Call SetHeading("Indexes:")
If rsKeyTemp.EOF Then
Call SetTextAfter("-NA-")
End If
While Not rsKeyTemp.EOF
Call SetTextAfter(rsKeyTemp(0))
rsKeyTemp.MoveNext
Wend
'****************************************************
'******************Views***************

'Clone the recordset object to find the indexes of the table
Set rsKeyTemp = rsKey.Clone(adLockReadOnly)
rsKeyTemp.Filter = "col2='View'"
'Set the labelling in the document
Call SetHeading("Views:")
If rsKeyTemp.EOF Then
Call SetTextAfter("-NA-")
End If
While Not rsKeyTemp.EOF
Call SetTextAfter(rsKeyTemp(0))
rsKeyTemp.MoveNext
Wend

'************************************
'******************Stored Procedures***************

'Clone the recordset object to find the indexes of the table
Set rsKeyTemp = rsKey.Clone(adLockReadOnly)
rsKeyTemp.Filter = "col2='Stored Procedure'"
'Set the labelling in the document
Call SetHeading("Stored Procedures:")
If rsKeyTemp.EOF Then
Call SetTextAfter("-NA-")
End If
While Not rsKeyTemp.EOF
Call SetTextAfter(rsKeyTemp(0))
rsKeyTemp.MoveNext
Wend

'************************************
'******************Functions***************

'Clone the recordset object to find the indexes of the table
Set rsKeyTemp = rsKey.Clone(adLockReadOnly)
rsKeyTemp.Filter = "col2='Function'"
'Set the labelling in the document
Call SetHeading("Functions:")
If rsKeyTemp.EOF Then
Call SetTextAfter("-NA-")
End If
While Not rsKeyTemp.EOF
Call SetTextAfter(rsKeyTemp(0))
rsKeyTemp.MoveNext
Wend

'************************************
'******************Triggers***************

'Clone the recordset object to find the indexes of the table
Set rsKeyTemp = rsKey.Clone(adLockReadOnly)
rsKeyTemp.Filter = "col2='Trigger'"
'Set the labelling in the document
Call SetHeading("Triggers:")
If rsKeyTemp.EOF Then
Call SetTextAfter("-NA-")
End If
While Not rsKeyTemp.EOF
Call SetTextAfter(rsKeyTemp(0))
rsKeyTemp.MoveNext
Wend
End If
'************************************
'Set the labelling in the document
Call SetHeading("Table Column Details")
'Procedure to position the cursor in the document
Call MoveDown

On Error GoTo Err

'Query to get the column names of the table
strQuery = ""
strQuery = "select col.name columname,typ.name datatype,col.max_length lenght,tbl.name tablename ," & _
" isnull(prop.Value,'') colDesc " & _
" from sys.columns col " & _
" inner join sys.types typ on col.user_type_id = typ.user_type_id " & _
" inner join sys.tables tbl on col.object_id = tbl.Object_id " & _
" left outer join sys.extended_properties prop " & _
" on prop.major_id = col.object_id and prop.minor_id = col.column_id " & _
" Where tbl.name = '" & rsMain(0) & "'"

'strQuery = "select st.name,col.* from syscolumns col inner join " & _
' " sysobjects sob on col.id = sob.id and sob.XType = 'U' " & _
' " inner join systypes st on col.usertype = st.usertype " & _
' " and col.xtype = st.xtype " & _
' " and sob.Name = '" & rsMain(0) & "'"
If rsFields.State = 1 Then rsFields.Close
rsFields.Open strQuery, conn, adOpenStatic, adLockReadOnly

If Not rsFields Is Nothing And rsFields.Fields.Count > 0 Then

'Create the table in the document to display the columns
'Table will display "Field Name","Field Type","Size","Key","Description"


.Tables.Add Range:=Selection.Range, NumRows:=rsFields.RecordCount + 1, NumColumns _
:=5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed

.Tables(row).Cell(1, 1).Shading.BackgroundPatternColor = wdColorGray20
.Tables(row).Cell(1, 1).Range.InsertBefore "Field Name"
.Tables(row).Cell(1, 1).Range.Bold = True
.Tables(row).Cell(1, 2).Range.InsertBefore "Field Type"
.Tables(row).Cell(1, 2).Shading.BackgroundPatternColor = wdColorGray20
.Tables(row).Cell(1, 2).Range.Bold = True
.Tables(row).Cell(1, 3).Range.InsertBefore "Size"
.Tables(row).Cell(1, 3).Shading.BackgroundPatternColor = wdColorGray20
.Tables(row).Cell(1, 3).Range.Bold = True
Call .Tables(row).Columns(2).SetWidth(75, wdAdjustSameWidth)
Call .Tables(row).Columns(3).SetWidth(40, wdAdjustSameWidth)
Call .Tables(row).Columns(4).SetWidth(20, wdAdjustSameWidth)
.Tables(row).Cell(1, 4).Range.InsertBefore "Key"
.Tables(row).Cell(1, 4).Shading.BackgroundPatternColor = wdColorGray20
.Tables(row).Cell(1, 4).Range.Bold = True
.Tables(row).Cell(1, 5).Range.InsertBefore "Description"
.Tables(row).Cell(1, 5).Shading.BackgroundPatternColor = wdColorGray20
.Tables(row).Cell(1, 5).Range.Bold = True
I = 0
While Not rsFields.EOF
.Tables(row).Cell(I + 2, 1).Range.InsertBefore rsFields(0)
.Tables(row).Cell(I + 2, 2).Range.InsertBefore rsFields(1)
.Tables(row).Cell(I + 2, 3).Range.InsertBefore rsFields(2)
.Tables(row).Cell(I + 2, 5).Range.InsertBefore rsFields(4)
rsFields.MoveNext
I = I + 1
Wend
End If

'Query to retrieve the constraints,Keys and Identity of the table

strQuery = "select c.COLUMN_NAME,CONSTRAINT_TYPE,'' as DefaultValue " & _
" from INFORMATION_SCHEMA.TABLE_CONSTRAINTS pk ," & _
" INFORMATION_SCHEMA.KEY_COLUMN_USAGE c" & _
" where pk.TABLE_NAME = '" & rsMain(0) & "' " & _
" and c.TABLE_NAME = pk.TABLE_NAME" & _
" and c.CONSTRAINT_NAME = pk.CONSTRAINT_NAME" & _
" union" & _
" select c.name,'DEFAULT CONSTRAINT' AS defaultcontraint," & _
" replace(replace(ind.definition,'(',''),')','') AS DefaultValue" & _
" from sys.default_constraints ind" & _
" inner join sys.tables tab" & _
" on ind.parent_object_id = tab.object_id" & _
" inner join sys.columns c" & _
" on tab.object_id = c.object_id and" & _
" c.column_id = ind.parent_column_id" & _
" where tab.name = '" & rsMain(0) & "' " & _
" union " & _
" select COLUMN_NAME, 'IDENTITY' AS defaultcontraint,'' as DefaultValue " & _
" from INFORMATION_SCHEMA.Columns " & _
" where TABLE_NAME = '" & rsMain(0) & "' " & _
" and COLUMNPROPERTY(object_id(TABLE_NAME), COLUMN_NAME, 'IsIdentity') = 1"

If rsKey.State = 1 Then rsKey.Close
rsKey.Open strQuery, conn, adOpenStatic, adLockOptimistic
If Not rsKey Is Nothing Then
'Iterate through the recordset to find the constraints,Keys and Identity of the table
While Not rsKey.EOF
I = 0
rsFields.MoveFirst
'Iterate throught the fields recordset and set the keys in the 4 and 5 columns of the table
Do While Not rsFields.EOF
If UCase(rsFields(1)) = UCase(rsKey(0)) Then
If UCase(rsKey(1)) = "FOREIGN KEY" Then
.Tables(row).Cell(I + 2, 4).Range.InsertBefore "FK"
Exit Do
ElseIf UCase(rsKey(1)) = "PRIMARY KEY" Then
.Tables(row).Cell(I + 2, 4).Range.InsertBefore "PK"
Exit Do
ElseIf UCase(rsKey(1)) = "DEFAULT CONSTRAINT" Then
.Tables(row).Cell(I + 2, 5).Range.InsertBefore "Default Value is " & rsKey(2)
Exit Do
ElseIf UCase(rsKey(1)) = "IDENTITY" Then
.Tables(row).Cell(I + 2, 5).Range.InsertBefore "Identity Column"
Exit Do
End If
End If
I = I + 1
rsFields.MoveNext
Loop
rsKey.MoveNext
Wend
End If


End With
row = row + 1
rsMain.MoveNext
Wend
Exit Sub
Err:
MsgBox Err.Description
Call SetHeading("Error in the table: " & rsMain(0))
Set rsMain = Nothing
Set rsFields = Nothing
Set rsKey = Nothing
End Sub
Sub MoveDown()
Dim Range3 As Range
Dim I As Integer
On Error Resume Next

I = ActiveDocument.Tables.Count
Set Range3 = ActiveDocument.Range(Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End)
Range3.MoveEnd Unit:=wdCharacter, Count:=1
Range3.SetRange Start:=Range3.Start + 2, End:=Range3.End
Range3.Select
With Selection
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
End With
End Sub

Sub SetText(str As String)
Dim Range3 As Range
Dim I As Integer
On Error Resume Next
I = ActiveDocument.Tables.Count
Set Range3 = ActiveDocument.Range(Start:=ActiveDocument.Tables(I).Range.End, End:=ActiveDocument.Tables(I).Range.End)
Range3.MoveEnd Unit:=wdCharacter, Count:=1
Range3.SetRange Start:=Range3.Start + 2, End:=Range3.End + Len(str)
Range3.Select
With Selection
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
.InsertParagraph
.Font.Name = "verdana"
.Font.Size = 10
.InsertBefore str
End With
End Sub

Sub SetTextAfter(str As String)
Dim Range3 As Range
Dim I As Integer
On Error Resume Next
I = ActiveDocument.Tables.Count
Set Range3 = ActiveDocument.Range(Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End)
Range3.MoveEnd Unit:=wdCharacter, Count:=1
Range3.SetRange Start:=Range3.Start + 2, End:=Range3.End + Len(str)
Range3.Select
With Selection
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
.Font.Name = "verdana"
.Font.Size = 10
.InsertAfter vbTab & str
End With
End Sub

Sub SetHeading(str As String)
Dim Range3 As Range
Dim I As Integer
On Error Resume Next
I = ActiveDocument.Tables.Count
Set Range3 = ActiveDocument.Range(Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End)
Range3.MoveEnd Unit:=wdCharacter, Count:=1
Range3.SetRange Start:=Range3.Start + 2, End:=Range3.End + Len(str)
Range3.Select

With Selection
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
.Font.Name = "verdana"
.Font.Size = 10
.TypeParagraph
.Font.Bold = wdToggle
.Font.ColorIndex = wdGreen
.TypeText (Space(3) & str)
.Font.ColorIndex = wdBlack
.Font.Bold = wdToggle
End With
End Sub

Sub SetTableName(str As String)
Dim Range3 As Range
Dim I As Integer
On Error Resume Next
I = ActiveDocument.Tables.Count
Set Range3 = ActiveDocument.Range(Start:=ActiveDocument.Tables(I).Range.End, End:=ActiveDocument.Tables(I).Range.End)
Range3.MoveEnd Unit:=wdCharacter, Count:=1
Range3.SetRange Start:=Range3.Start + 2, End:=Range3.End + Len(str)
Range3.Select
With Selection
.Collapse Direction:=wdCollapseEnd
.TypeParagraph
.Font.Name = "verdana"
.Font.Size = 11
.Font.Italic = True
.Font.Bold = wdToggle
.Font.Color = wdColorDarkRed
.TypeText "Table Name: "
.Font.ColorIndex = wdBlack
.Font.Bold = wdToggle
.TypeText str
.Font.Italic = False
End With
End Sub
QuestionNeed this for a oracle database Pin
Member 1048363723-Dec-13 3:02
Member 1048363723-Dec-13 3:02 
Questionvery nice tool Pin
harsh.programmer22-Feb-12 0:35
harsh.programmer22-Feb-12 0:35 
Questionfor non VB developers Pin
Member 852727129-Dec-11 19:07
Member 852727129-Dec-11 19:07 
GeneralThanks Pin
sreelekhamenon8-Dec-10 14:07
sreelekhamenon8-Dec-10 14:07 
Generalthanks Pin
velpetit9-Dec-09 18:06
velpetit9-Dec-09 18:06 
Generalole db Pin
Svetlana Tipping18-Feb-09 22:38
Svetlana Tipping18-Feb-09 22:38 
GeneralWord 2007 Pin
Hawks Talon17-Jun-08 8:09
Hawks Talon17-Jun-08 8:09 
GeneralMacro not working Pin
Niranjan Singh14-Apr-08 3:15
Niranjan Singh14-Apr-08 3:15 
GeneralRe: Macro not working Pin
grom_boy14-Apr-08 23:36
grom_boy14-Apr-08 23:36 
GeneralRe: Macro not working [modified] Pin
AndrewGail24-Apr-08 5:12
AndrewGail24-Apr-08 5:12 
Last Visit: 31-Dec-99 18:00     Last Update: 29-Apr-24 8:31Refresh1

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Permalink
Advertise
Privacy
Cookies
Terms of Use
Layout: fixed | fluid

Posted 31 Mar 2008

Article Copyright 2008 by Shashidhar Rao Nellutla
Everything else Copyright © CodeProject, 1999-2024

Web01 2.8:2024-04-02:1