|
thanks for all , this is really helpful
it works for me with the latest modification on SQL server 2014 . but it does not get any information about the stored producers .
any one can help ?
thanks
|
|
|
|
|
Sub DatabaseDocumentation()
'
' DatabaseDocumentation Macro
'
'Attribute VB_Name = "NewMacros"
'End Sub
'Sub About()
'
' Macro created 3/18/2008 by shashi
' Macro Modified 29/07/215 by Pavel Flores Run in SQL Server 2015 Fix PKs
'
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=Pato12345;Initial Catalog=VegaServer3;Data Source=localhost"
'Open the recordset to retrieve the tables in the database
If rsMain.State = 1 Then rsMain.Close
rsMain.Open "Select * 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 columname,datatype,lenght, PKey + Fkey as PFKey, RefTable + colDesc as colDesc from " & _
"(select col.name columname,typ.name datatype,col.max_length lenght,tbl.name tablename , CAST(isnull(prop.Value,'') as nvarchar(1000)) colDesc, " & _
" CASE WHEN d.name is null THEN '' ELSE 'PK' END as PKey, CASE WHEN e.parent_object_id is null THEN '' ELSE 'FK' END as FKey," & _
" CASE WHEN e.parent_object_id is null THEN '' ELSE 'Reference with: ' + g.name + ' ' END RefTable" & _
" from sysobjects so join sys.columns col on so.id = col.object_id" & _
" 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 " & _
" left join (SELECT so.id,sc.colid,sc.name " & _
" FROM syscolumns sc " & _
" JOIN sysobjects so ON so.id = sc.id " & _
" JOIN sysindexkeys si ON so.id = si.id " & _
" and sc.colid = si.colid " & _
" WHERE si.indid = 1) d on so.id = d.id and col.column_id = d.colid " & _
" left join sys.foreign_key_columns as e on so.id = e.parent_object_id and col.column_id = e.parent_column_id " & _
" left join sys.objects as g on e.referenced_object_id = g.object_id " & _
" Where tbl.name = '" & rsMain(0) & "') as t1"
'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, 4).Range.InsertBefore rsFields(3)
.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
|
|
|
|
|
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
|
|
|
|
|
|
it really saved lot of time
|
|
|
|
|
hi, i'm not a VB developer, i only know some the basics of C#, can you please guide me how to run this code. also if knowing VB is not required to run this code, can you guide me how to run this code in MS word 2010? thanks a lot
|
|
|
|
|
Thanks a lot.It worked like a charm and saved me a lot time.. 
|
|
|
|
|
thanks for this wonderful post.....It helped me a lot
and saved me junks of time
|
|
|
|
|
Hi everyone,
how can i connect to an Oracle database to produce data dictionary using similar code? thanks
Lana
|
|
|
|
|
Word 2007 does not like the "Attribute" declarations, so you will need to remove those in order for it to work.
|
|
|
|
|
Hi,
This macro is not working,getting error on sys.tables and like statements.
Could you please upload a word document which is working with this macro?
I tried this on MSOffice 2003 and SQL Server 2000, and it is not working.
Thanks.
|
|
|
|
|
yeah.. I'm also getting simliar errors...
I was quite excited to see this so if your able to get it to work I will be very grateful...
Steve
|
|
|
|
|
I tried this as well, unfortunately sys.tables is SQL Server 2005, not 2000.
I'll try it on our development 2K5 server and see if it works, if not I'll look at changing it to work with SQL 2000 sysobjects e.g.
SELECT * FROM dbo.sysobjects WHERE xtype = 'u' ORDER BY Name
Edit: Tried it on a SQL 2K5 server and it appears to do nothing??? No errors at all, weird...
Will have a go at modding the code to work with SQL 2000 and see how that fairs.
modified on Thursday, April 24, 2008 11:27 AM
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
