I built my tables in visio for my database and thought you could get the 
code to create the tables and relations but I can't seem to find it.

There is a view code page but not sure if that is the schema code.

Can you build a schema script from visio?

I am running 2003 professional.

Thanks,

Tom 

I wasn't sure where to put this because even though I look at newsgroups on 
msnew.microsoft.com where there are 6 visio newsgroups listed - when I try 
to open any of them I get a message saying that it isn't available on the 
new server.

Tom

"tshad" <tfs@dslextreme.com> wrote in message 
news:eyauYpfTLHA.2100@TK2MSFTNGP04.phx.gbl...
>I built my tables in visio for my database and thought you could get the 
>code to create the tables and relations but I can't seem to find it.
>
> There is a view code page but not sure if that is the schema code.
>
> Can you build a schema script from visio?
>
> I am running 2003 professional.
>
> Thanks,
>
> Tom
> 

> Can you build a schema script from visio? <

See, if below helps, but be aware that you can not script everything
out of Visio what you can input as Visio VBA does not have access to
some properties (comments in the code).

You will most propably have to remove some line breaks in the code.

brgds

Philipp Post


+++++++++++++++++++++++++++++++++++++++++++++++++++++

Option Explicit

'--------------------------------------------------------------------------------------------------
'Description: Convert a Visio 2003 Entity Relationship Diagram to SQL
DDL
'Pattern Source:
http://groups.google.com/group/micro...c375e8244dfa28
'History
'Date Author Changes
'2008-05-01 JW Initial Version
'2010-04-05 Philipp Post Changed to write ISO/ANSI SQL DDL
instead of an Access Database
'--------------------------------------------------------------------------------------------------

'The goal is to keep the output as much as possible in standard SQL,
so that it will run in
'any SQL RDBMS without too much effort.

'How to install: Put the code into a new module in the *.vsd Visio
drawing and run it from the macros menu.
'Needs a reference to Visio Database Modelling Engine

'Warning: a lot of things, which can be entered in the UI can not be
scripted out, e. g.
'- CHECK constraints
'- DEFAULT values of columns in tables (not possible according to a
web search)
'- notes (not possible according to a web search)
'- VIEWs eVMEKindERView (mixed into entity = table / eVMEKindEREntity)

Public Sub Create_DDL()

'Visio Modelling Engine
Static vme As New VisioModelingEngine
Dim vis_models As IEnumIVMEModels
Dim vis_model As IVMEModel
Dim vis_shapes As IEnumIVMEModelElements
Dim vis_shape As IVMEModelElement

'Tables
Dim vis_table_def As IVMEEntity
Dim vis_table_attribs As IEnumIVMEAttributes
Dim vis_column_def As IVMEAttribute
Dim vis_data_type As IVMEDataType
Dim table_name As String
Dim column_name As String

'Indexes
Dim vis_indexes As IEnumIVMEEntityAnnotations
Dim vis_index As IVMEEntityAnnotation
Dim vis_index_columns As IEnumIVMEAttributes
Dim vis_index_column As IVMEAttribute

'Relationships
Dim vis_relationship As IVMEBinaryRelationship
Dim vis_referenced_columns As IEnumIVMEAttributes
Dim vis_referenced_column As IVMEAttribute
Dim vis_referencing_columns As IEnumIVMEAttributes
Dim vis_referencing_column As IVMEAttribute
Dim constraint_name As String
Dim referencing_table_name As String
Dim referenced_table_name As String

'Output File
Dim file_name As String
Dim response As String
Dim ind_response As String
Dim write_indexes_flag As Boolean

'There is no save as file dialog in Visio VBA (would need access
through API)
file_name = InputBox("Save the DDL file here:", "Save file as", "D:
\Visio_DDL.sql")
'User clicked cancel
If file_name = "" Then Exit Sub

Open file_name For Output As #1

'Print CREATE INDEX statements or not
If MsgBox("Should CREATE INDEX statements be included?", vbYesNo,
"Create DDL") = vbYes Then
write_indexes_flag = True
End If

'Set up refernces to entities ie tables and relationships in the
visio modelling engine
Set vis_models = vme.models
Set vis_model = vis_models.Next
Set vis_shapes = vis_model.elements
Set vis_shape = vis_shapes.Next

'for SQL Server only
response = "-- SQL Server specific settings" & vbCrLf & _
"SET ANSI_NULLS ON " & vbCrLf & _
"GO" & vbCrLf & _
"SET QUOTED_IDENTIFIER ON" & vbCrLf & _
"GO" & vbCrLf & vbCrLf


'On Error GoTo TblErr

response = response & vbCrLf & "--------------------------- TABLES
---------------------------" & vbCrLf & vbCrLf

'Add tables and indexes
Do While Not vis_shape Is Nothing

'Have we got a table definition?
'something is wrong with the VIEW definitions - they are
considered as tables
'although they should be eVMEKindERView
'Original Source: The Code Cage Forums
http://www.thecodecage.com/forumz/charts-timelines/194683-forward-engineer-visio-er-diagram-sql-ddl.html#post696244

If vis_shape.Type = eVMEKindEREntity Then

'Add Tables

'Set a refernce to the table definition
Set vis_table_def = vis_shape

table_name =
Make_Name_SQL_Compatible(vis_table_def.PhysicalName)

response = response & "CREATE TABLE " & table_name &
vbCrLf & _
"("


'Set a refernce to the columns category of the table
definition
Set vis_table_attribs = vis_table_def.Attributes

'Select first row of column data in the columns category
Set vis_column_def = vis_table_attribs.Next

Do While Not vis_column_def Is Nothing

'Set a reference to the columns datatype
Set vis_data_type = vis_column_def.DataType

'Get the name of the column
column_name =
Make_Name_SQL_Compatible(vis_column_def.PhysicalName)

'Put conceptual column in DDL comments as there is
'no standard, how this is stored in the DB

'http://www.ureader.com/msg/1133174.aspx
'The notes property for ER shapes is not exposed via
the COM interface, so
'you won't be able to get them.

If vis_column_def.ConceptualName <>
vis_column_def.PhysicalName Then
response = response & "-- " &
vis_column_def.ConceptualName & vbCrLf & " "
End If

response = response & column_name

'Portable data types (SQL Standard)
'CHAR
'DECIMAL
'INTEGER
'REAL
'SMALLINT
'VARCHAR

'Proprietary data types
'BINARY
'BIT (in Ansi it is like BINARY in MS Access, no
direct replacement)
'BYTE --> SMALLINT
'COUNTER --> IDENTITY
'CURRENCY --> DECIMAL(15, 4)
'DATETIME --> SQL Standard + DB2 = TIMESTAMP (but NOT
in SQL Server)
'DOUBLE --> FLOAT
'GUID --> CHAR(32)
'LONG --> INTEGER
'LONGBINARY
'LONGCHAR
'LONGTEXT
'NUMERIC --> DECIMAL
'SHORT --> SMALLINT
'SINGLE --> REAL
'TEXT --> NVARCHAR(MAX) in SQL Server,
CLOB(1073741823) in DB2
'VARBINARY

'data type
If vis_data_type.PhysicalName = "BIT" Then
'no direct replacement in SQL Standard (in SQL
Server BIT exists)
'Should be replaced with CHAR(1) NOT NULL
CHECK(<column name> IN('Y', 'N'))
response = response & " CHAR(1)"
ElseIf vis_data_type.PhysicalName = "BYTE" Then
response = response & " SMALLINT"
ElseIf vis_data_type.PhysicalName = "COUNTER" Then
'Identity property (SQL Server, MS Access)
response = response & " IDENTITY(1, 1)"
'IBM DB2
'response = response & " INTEGER " & vbCrLf & _
' " GENERATED BY DEFAULT AS
IDENTITY (START WITH 1, INCREMENT BY 1, CACHE 20)"
ElseIf vis_data_type.PhysicalName = "CURRENCY" Then
'MS Money data type should not be used due to math
problems
response = response & " DECIMAL(15, 4)"
ElseIf vis_data_type.PhysicalName = "DOUBLE" Then
'FLOAT is SQL Standard
response = response & " FLOAT"
ElseIf vis_data_type.PhysicalName = "GUID" Then
'GUID can be replaced
response = response & " CHAR(32)"
ElseIf vis_data_type.PhysicalName = "LONG" Then
response = response & " INTEGER"
ElseIf vis_data_type.PhysicalName = "LONGBINARY" Then
'proprietary SQL Server replacement (old: IMAGE)
response = response & " VARBINARY(MAX)"
ElseIf vis_data_type.PhysicalName = "LONGCHAR" Or _
vis_data_type.PhysicalName = "LONGTEXT" Or _
vis_data_type.PhysicalName = "TEXT" Then
'proprietary SQL Server replacement
'MS Access always uses Unicode for LONGTEXT
response = response & " NVARCHAR(MAX)"
ElseIf vis_data_type.PhysicalName Like "NUMERIC*" Then
'As per MS Access help system NUMERIC should be
converted to DECIMAL
response = response &
Replace(vis_data_type.PhysicalName, "NUMERIC", "DECIMAL")
ElseIf vis_data_type.PhysicalName = "SHORT" Then
response = response & " SMALLINT"
ElseIf vis_data_type.PhysicalName = "SINGLE" Then
'floating point number
response = response & " REAL"
Else
response = response & " " &
vis_data_type.PhysicalName
End If

'Nullability
If vis_column_def.AllowNulls = False Then
response = response & " NOT NULL"
Else
'SQL standard does not require this, but some
rdbms do
'response = response & " NULL"
End If

'DEFAULT values ???
'CHECK constraints ???

'CHECK constraints based on special data types
If vis_data_type.PhysicalName = "BIT" Then
response = response & vbCrLf
response = response & " CHECK(" & column_name & "
IN('Y', 'N'))"
End If

response = response & ", " & vbCrLf & " "

'Select next column in the table definition
Set vis_column_def = vis_table_attribs.Next

Loop

'Add Indexes and Keys

'On Error GoTo IndErr

'Select the indexes in the table definition
Set vis_indexes = vis_table_def.EntityAnnotations

'Select the first Index in the table definition
Set vis_index = vis_indexes.Next
ind_response = ""

Do While Not vis_index Is Nothing

'Create the Index in the database

'VBA does not make a difference between the fact if a
constraint or a key or both
'are concerned as the Visio user interface does

Select Case vis_index.kind

'Primary Key constraint
Case eVMEEREntityAnnotationPrimary
response = response & "CONSTRAINT " &
Make_Name_SQL_Compatible(vis_index.PhysicalName) & " " & vbCrLf & _
" PRIMARY KEY ("

'For SQL server it should be CLUSTERED index,
for DB2 UNIQUE index
ind_response = ind_response & " CREATE UNIQUE
INDEX " & Make_Name_SQL_Compatible(vis_index.PhysicalName & "_IDX") &
" " & vbCrLf & _
" ON " &
table_name & " ("

'Unique constraint
Case eVMEEREntityAnnotationAlternate
response = response & "CONSTRAINT " &
Make_Name_SQL_Compatible(vis_index.PhysicalName) & " " & vbCrLf & _
" UNIQUE ("

'Not unique index
Case eVMEEREntityAnnotationIndex
ind_response = ind_response & " CREATE INDEX "
& Make_Name_SQL_Compatible(vis_index.PhysicalName & "_IDX") & " " &
vbCrLf & _
" ON " &
table_name & " ("

Case eVMEEREntityAnnotationUpperBound
'do nothing - not sure what this is for

End Select

'Select the first column of the Index Definition
Set vis_index_columns = vis_index.Attributes
Set vis_index_column = vis_index_columns.Next

Do While Not vis_index_column Is Nothing

Select Case vis_index.kind

'Primary Key constraint
Case eVMEEREntityAnnotationPrimary
response = response &
Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "
ind_response = ind_response &
Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "

'Unique constraint
Case eVMEEREntityAnnotationAlternate
response = response &
Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "

'Not unique index
Case eVMEEREntityAnnotationIndex
ind_response = ind_response &
Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "

Case eVMEEREntityAnnotationUpperBound
'do nothing - not sure what this is for

End Select


'Select the next column in the index definition
Set vis_index_column = vis_index_columns.Next

Loop


Select Case vis_index.kind

'Primary Key constraint
Case eVMEEREntityAnnotationPrimary

'strip last , of the key column list
response = Left(response, Len(response) - 2)
response = response & "), " & vbCrLf & " "

'strip last , of the index column list
ind_response = Left(ind_response,
Len(ind_response) - 2)
ind_response = ind_response & "); " & vbCrLf &
vbCrLf

'Unique constraint
Case eVMEEREntityAnnotationAlternate

'strip last , of the key column list
response = Left(response, Len(response) - 2)
response = response & "), " & vbCrLf & " "

'Not unique index
Case eVMEEREntityAnnotationIndex
'strip last , of the index column list
ind_response = Left(ind_response,
Len(ind_response) - 2)
ind_response = ind_response & "); " & vbCrLf &
vbCrLf

Case eVMEEREntityAnnotationUpperBound
'do nothing - not sure what this is for

End Select

'Select the next index in the data vis_model
Set vis_index = vis_indexes.Next

Loop

'strip last , of the column/constraint list
'and terminate the CREATE TABLE statement
response = Left(response, Len(response) - 5)
response = response & ");" & vbCrLf & vbCrLf

'add the CREATE INDEX statements right after the table
If write_indexes_flag = True Then
response = response & ind_response
End If

End If

Set vis_shape = vis_shapes.Next

Loop

'End first pass, Set up for the second pass through the vis_model
'On Error GoTo RelErr

Set vis_shapes = vis_model.elements
Set vis_shape = vis_shapes.Next

response = response & vbCrLf & "---------------------------
FOREIGN KEYS ---------------------------" & vbCrLf & vbCrLf

Do While Not vis_shape Is Nothing

'Have we got a relationship?
If vis_shape.Type = eVMEKindERRelationship Then

'Add relationships

Set vis_relationship = vis_shape

'Create Relationship
constraint_name =
Make_Name_SQL_Compatible(vis_relationship.PhysicalName)
'Specify the related / foreign table. (The parent table in
VME)
referencing_table_name =
Make_Name_SQL_Compatible(vis_relationship.FirstEntity.PhysicalName)
'Specify the primary table. (The child table in VME)
referenced_table_name =
Make_Name_SQL_Compatible(vis_relationship.SecondEntity.PhysicalName)

response = response & "ALTER TABLE " &
referencing_table_name & " " & vbCrLf & _
" ADD CONSTRAINT " & constraint_name
& " " & vbCrLf & _
" FOREIGN KEY ("

'Add the columns to the relationship

'Read Foreign table columns
Set vis_referencing_columns =
vis_relationship.FirstAttributes
Set vis_referencing_column = vis_referencing_columns.Next

Do While Not vis_referencing_column Is Nothing

response = response &
Make_Name_SQL_Compatible(vis_referencing_column.PhysicalName) & ", "
'Repeat for other columns if a multi-column relation.
Set vis_referencing_column =
vis_referencing_columns.Next

Loop

'strip last ,
response = Left(response, Len(response) - 2)
response = response & ")" & vbCrLf


'Read Primary table columns
Set vis_referenced_columns =
vis_relationship.SecondAttributes
Set vis_referenced_column = vis_referenced_columns.Next

response = response & " REFERENCES " &
referenced_table_name & " ("

Do While Not vis_referenced_column Is Nothing

response = response &
Make_Name_SQL_Compatible(vis_referenced_column.PhysicalName) & ", "
'Repeat for other columns if a multi-column relation.
Set vis_referenced_column =
vis_referenced_columns.Next

Loop

'strip last ,
response = Left(response, Len(response) - 2)
response = response & ")" & vbCrLf

'define update and delete rules
Select Case vis_relationship.UpdateRule
Case eVMERIRuleCascade
response = response & " ON UPDATE CASCADE" &
vbCrLf
Case eVMERIRuleSetNull
response = response & " ON UPDATE SET NULL" &
vbCrLf
Case eVMERIRuleSetDefault
response = response & " ON UPDATE SET DEFAULT" &
vbCrLf
Case eVMERIRuleNoAction
'ON UPDATE RESTRICT is standard - must not mention
End Select

Select Case vis_relationship.DeleteRule
Case eVMERIRuleCascade
response = response & " ON DELETE CASCADE" &
vbCrLf
Case eVMERIRuleSetNull
response = response & " ON DELETE SET NULL" &
vbCrLf
Case eVMERIRuleSetDefault
response = response & " ON DELETE SET DEFAULT" &
vbCrLf
Case eVMERIRuleNoAction
'ON DELETE RESTRICT is standard - must not mention
End Select

'strip last crlf of the column list
response = Left(response, Len(response) - 2)
response = response & ";" & vbCrLf & vbCrLf

End If

Set vis_shape = vis_shapes.Next

Loop

'Write the resulte to file and close it
Print #1, response
Close (1)


Exit Sub

TblErr:
Debug.Print "Tbl Err"
Debug.Print " "
Resume Next

IndErr:
Debug.Print vis_table_def.PhysicalName, vis_index.PhysicalName,
Err.Description, "Idx Err"
Debug.Print " "
Resume Next

RelErr:
Debug.Print vis_relationship.SecondEntity.PhysicalName,
vis_relationship.FirstEntity.PhysicalName, Err.Description, "Rel Err"
Debug.Print " "
Resume Next

End Sub

'Description: Handle white spaces in object names
'Author: PP 2010-04-06
Private Function Make_Name_SQL_Compatible(ByVal object_name As String)
As String

If InStr(1, object_name, " ") > 0 Then
'for table names with spaces in it
'as per ANSI, use double quotes
'SQL Server uses [], but can be set to double quotes - SET
QUOTED_IDENTIFIER ON
object_name = """" & object_name & """"
End If

Make_Name_SQL_Compatible = object_name

End Function

That looks great.

But how do I run it?  Do I need to install it?

Thanks,

Tom

"Philipp Post" <post.philipp@googlemail.com> wrote in message 
news:d6f2c4c6-2474-4a74-90bf-d84a7c6c100e@f25g2000yqc.googlegroups.com...
>> Can you build a schema script from visio? <
>
> See, if below helps, but be aware that you can not script everything
> out of Visio what you can input as Visio VBA does not have access to
> some properties (comments in the code).
>
> You will most propably have to remove some line breaks in the code.
>
> brgds
>
> Philipp Post
>
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++
>
> Option Explicit
>
> '--------------------------------------------------------------------------------------------------
> 'Description: Convert a Visio 2003 Entity Relationship Diagram to SQL
> DDL
> 'Pattern Source:
> http://groups.google.com/group/micro...c375e8244dfa28
> 'History
> 'Date Author Changes
> '2008-05-01 JW Initial Version
> '2010-04-05 Philipp Post Changed to write ISO/ANSI SQL DDL
> instead of an Access Database
> '--------------------------------------------------------------------------------------------------
>
> 'The goal is to keep the output as much as possible in standard SQL,
> so that it will run in
> 'any SQL RDBMS without too much effort.
>
> 'How to install: Put the code into a new module in the *.vsd Visio
> drawing and run it from the macros menu.
> 'Needs a reference to Visio Database Modelling Engine
>
> 'Warning: a lot of things, which can be entered in the UI can not be
> scripted out, e. g.
> '- CHECK constraints
> '- DEFAULT values of columns in tables (not possible according to a
> web search)
> '- notes (not possible according to a web search)
> '- VIEWs eVMEKindERView (mixed into entity = table / eVMEKindEREntity)
>
> Public Sub Create_DDL()
>
> 'Visio Modelling Engine
> Static vme As New VisioModelingEngine
> Dim vis_models As IEnumIVMEModels
> Dim vis_model As IVMEModel
> Dim vis_shapes As IEnumIVMEModelElements
> Dim vis_shape As IVMEModelElement
>
> 'Tables
> Dim vis_table_def As IVMEEntity
> Dim vis_table_attribs As IEnumIVMEAttributes
> Dim vis_column_def As IVMEAttribute
> Dim vis_data_type As IVMEDataType
> Dim table_name As String
> Dim column_name As String
>
> 'Indexes
> Dim vis_indexes As IEnumIVMEEntityAnnotations
> Dim vis_index As IVMEEntityAnnotation
> Dim vis_index_columns As IEnumIVMEAttributes
> Dim vis_index_column As IVMEAttribute
>
> 'Relationships
> Dim vis_relationship As IVMEBinaryRelationship
> Dim vis_referenced_columns As IEnumIVMEAttributes
> Dim vis_referenced_column As IVMEAttribute
> Dim vis_referencing_columns As IEnumIVMEAttributes
> Dim vis_referencing_column As IVMEAttribute
> Dim constraint_name As String
> Dim referencing_table_name As String
> Dim referenced_table_name As String
>
> 'Output File
> Dim file_name As String
> Dim response As String
> Dim ind_response As String
> Dim write_indexes_flag As Boolean
>
> 'There is no save as file dialog in Visio VBA (would need access
> through API)
> file_name = InputBox("Save the DDL file here:", "Save file as", "D:
> \Visio_DDL.sql")
> 'User clicked cancel
> If file_name = "" Then Exit Sub
>
> Open file_name For Output As #1
>
> 'Print CREATE INDEX statements or not
> If MsgBox("Should CREATE INDEX statements be included?", vbYesNo,
> "Create DDL") = vbYes Then
> write_indexes_flag = True
> End If
>
> 'Set up refernces to entities ie tables and relationships in the
> visio modelling engine
> Set vis_models = vme.models
> Set vis_model = vis_models.Next
> Set vis_shapes = vis_model.elements
> Set vis_shape = vis_shapes.Next
>
> 'for SQL Server only
> response = "-- SQL Server specific settings" & vbCrLf & _
> "SET ANSI_NULLS ON " & vbCrLf & _
> "GO" & vbCrLf & _
> "SET QUOTED_IDENTIFIER ON" & vbCrLf & _
> "GO" & vbCrLf & vbCrLf
>
>
> 'On Error GoTo TblErr
>
> response = response & vbCrLf & "--------------------------- TABLES
> ---------------------------" & vbCrLf & vbCrLf
>
> 'Add tables and indexes
> Do While Not vis_shape Is Nothing
>
> 'Have we got a table definition?
> 'something is wrong with the VIEW definitions - they are
> considered as tables
> 'although they should be eVMEKindERView
> 'Original Source: The Code Cage Forums
> http://www.thecodecage.com/forumz/charts-timelines/194683-forward-engineer-visio-er-diagram-sql-ddl.html#post696244
>
> If vis_shape.Type = eVMEKindEREntity Then
>
> 'Add Tables
>
> 'Set a refernce to the table definition
> Set vis_table_def = vis_shape
>
> table_name =
> Make_Name_SQL_Compatible(vis_table_def.PhysicalName)
>
> response = response & "CREATE TABLE " & table_name &
> vbCrLf & _
> "("
>
>
> 'Set a refernce to the columns category of the table
> definition
> Set vis_table_attribs = vis_table_def.Attributes
>
> 'Select first row of column data in the columns category
> Set vis_column_def = vis_table_attribs.Next
>
> Do While Not vis_column_def Is Nothing
>
> 'Set a reference to the columns datatype
> Set vis_data_type = vis_column_def.DataType
>
> 'Get the name of the column
> column_name =
> Make_Name_SQL_Compatible(vis_column_def.PhysicalName)
>
> 'Put conceptual column in DDL comments as there is
> 'no standard, how this is stored in the DB
>
> 'http://www.ureader.com/msg/1133174.aspx
> 'The notes property for ER shapes is not exposed via
> the COM interface, so
> 'you won't be able to get them.
>
> If vis_column_def.ConceptualName <>
> vis_column_def.PhysicalName Then
> response = response & "-- " &
> vis_column_def.ConceptualName & vbCrLf & " "
> End If
>
> response = response & column_name
>
> 'Portable data types (SQL Standard)
> 'CHAR
> 'DECIMAL
> 'INTEGER
> 'REAL
> 'SMALLINT
> 'VARCHAR
>
> 'Proprietary data types
> 'BINARY
> 'BIT (in Ansi it is like BINARY in MS Access, no
> direct replacement)
> 'BYTE --> SMALLINT
> 'COUNTER --> IDENTITY
> 'CURRENCY --> DECIMAL(15, 4)
> 'DATETIME --> SQL Standard + DB2 = TIMESTAMP (but NOT
> in SQL Server)
> 'DOUBLE --> FLOAT
> 'GUID --> CHAR(32)
> 'LONG --> INTEGER
> 'LONGBINARY
> 'LONGCHAR
> 'LONGTEXT
> 'NUMERIC --> DECIMAL
> 'SHORT --> SMALLINT
> 'SINGLE --> REAL
> 'TEXT --> NVARCHAR(MAX) in SQL Server,
> CLOB(1073741823) in DB2
> 'VARBINARY
>
> 'data type
> If vis_data_type.PhysicalName = "BIT" Then
> 'no direct replacement in SQL Standard (in SQL
> Server BIT exists)
> 'Should be replaced with CHAR(1) NOT NULL
> CHECK(<column name> IN('Y', 'N'))
> response = response & " CHAR(1)"
> ElseIf vis_data_type.PhysicalName = "BYTE" Then
> response = response & " SMALLINT"
> ElseIf vis_data_type.PhysicalName = "COUNTER" Then
> 'Identity property (SQL Server, MS Access)
> response = response & " IDENTITY(1, 1)"
> 'IBM DB2
> 'response = response & " INTEGER " & vbCrLf & _
> ' " GENERATED BY DEFAULT AS
> IDENTITY (START WITH 1, INCREMENT BY 1, CACHE 20)"
> ElseIf vis_data_type.PhysicalName = "CURRENCY" Then
> 'MS Money data type should not be used due to math
> problems
> response = response & " DECIMAL(15, 4)"
> ElseIf vis_data_type.PhysicalName = "DOUBLE" Then
> 'FLOAT is SQL Standard
> response = response & " FLOAT"
> ElseIf vis_data_type.PhysicalName = "GUID" Then
> 'GUID can be replaced
> response = response & " CHAR(32)"
> ElseIf vis_data_type.PhysicalName = "LONG" Then
> response = response & " INTEGER"
> ElseIf vis_data_type.PhysicalName = "LONGBINARY" Then
> 'proprietary SQL Server replacement (old: IMAGE)
> response = response & " VARBINARY(MAX)"
> ElseIf vis_data_type.PhysicalName = "LONGCHAR" Or _
> vis_data_type.PhysicalName = "LONGTEXT" Or _
> vis_data_type.PhysicalName = "TEXT" Then
> 'proprietary SQL Server replacement
> 'MS Access always uses Unicode for LONGTEXT
> response = response & " NVARCHAR(MAX)"
> ElseIf vis_data_type.PhysicalName Like "NUMERIC*" Then
> 'As per MS Access help system NUMERIC should be
> converted to DECIMAL
> response = response &
> Replace(vis_data_type.PhysicalName, "NUMERIC", "DECIMAL")
> ElseIf vis_data_type.PhysicalName = "SHORT" Then
> response = response & " SMALLINT"
> ElseIf vis_data_type.PhysicalName = "SINGLE" Then
> 'floating point number
> response = response & " REAL"
> Else
> response = response & " " &
> vis_data_type.PhysicalName
> End If
>
> 'Nullability
> If vis_column_def.AllowNulls = False Then
> response = response & " NOT NULL"
> Else
> 'SQL standard does not require this, but some
> rdbms do
> 'response = response & " NULL"
> End If
>
> 'DEFAULT values ???
> 'CHECK constraints ???
>
> 'CHECK constraints based on special data types
> If vis_data_type.PhysicalName = "BIT" Then
> response = response & vbCrLf
> response = response & " CHECK(" & column_name & "
> IN('Y', 'N'))"
> End If
>
> response = response & ", " & vbCrLf & " "
>
> 'Select next column in the table definition
> Set vis_column_def = vis_table_attribs.Next
>
> Loop
>
> 'Add Indexes and Keys
>
> 'On Error GoTo IndErr
>
> 'Select the indexes in the table definition
> Set vis_indexes = vis_table_def.EntityAnnotations
>
> 'Select the first Index in the table definition
> Set vis_index = vis_indexes.Next
> ind_response = ""
>
> Do While Not vis_index Is Nothing
>
> 'Create the Index in the database
>
> 'VBA does not make a difference between the fact if a
> constraint or a key or both
> 'are concerned as the Visio user interface does
>
> Select Case vis_index.kind
>
> 'Primary Key constraint
> Case eVMEEREntityAnnotationPrimary
> response = response & "CONSTRAINT " &
> Make_Name_SQL_Compatible(vis_index.PhysicalName) & " " & vbCrLf & _
> " PRIMARY KEY ("
>
> 'For SQL server it should be CLUSTERED index,
> for DB2 UNIQUE index
> ind_response = ind_response & " CREATE UNIQUE
> INDEX " & Make_Name_SQL_Compatible(vis_index.PhysicalName & "_IDX") &
> " " & vbCrLf & _
> " ON " &
> table_name & " ("
>
> 'Unique constraint
> Case eVMEEREntityAnnotationAlternate
> response = response & "CONSTRAINT " &
> Make_Name_SQL_Compatible(vis_index.PhysicalName) & " " & vbCrLf & _
> " UNIQUE ("
>
> 'Not unique index
> Case eVMEEREntityAnnotationIndex
> ind_response = ind_response & " CREATE INDEX "
> & Make_Name_SQL_Compatible(vis_index.PhysicalName & "_IDX") & " " &
> vbCrLf & _
> " ON " &
> table_name & " ("
>
> Case eVMEEREntityAnnotationUpperBound
> 'do nothing - not sure what this is for
>
> End Select
>
> 'Select the first column of the Index Definition
> Set vis_index_columns = vis_index.Attributes
> Set vis_index_column = vis_index_columns.Next
>
> Do While Not vis_index_column Is Nothing
>
> Select Case vis_index.kind
>
> 'Primary Key constraint
> Case eVMEEREntityAnnotationPrimary
> response = response &
> Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "
> ind_response = ind_response &
> Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "
>
> 'Unique constraint
> Case eVMEEREntityAnnotationAlternate
> response = response &
> Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "
>
> 'Not unique index
> Case eVMEEREntityAnnotationIndex
> ind_response = ind_response &
> Make_Name_SQL_Compatible(vis_index_column.PhysicalName) & ", "
>
> Case eVMEEREntityAnnotationUpperBound
> 'do nothing - not sure what this is for
>
> End Select
>
>
> 'Select the next column in the index definition
> Set vis_index_column = vis_index_columns.Next
>
> Loop
>
>
> Select Case vis_index.kind
>
> 'Primary Key constraint
> Case eVMEEREntityAnnotationPrimary
>
> 'strip last , of the key column list
> response = Left(response, Len(response) - 2)
> response = response & "), " & vbCrLf & " "
>
> 'strip last , of the index column list
> ind_response = Left(ind_response,
> Len(ind_response) - 2)
> ind_response = ind_response & "); " & vbCrLf &
> vbCrLf
>
> 'Unique constraint
> Case eVMEEREntityAnnotationAlternate
>
> 'strip last , of the key column list
> response = Left(response, Len(response) - 2)
> response = response & "), " & vbCrLf & " "
>
> 'Not unique index
> Case eVMEEREntityAnnotationIndex
> 'strip last , of the index column list
> ind_response = Left(ind_response,
> Len(ind_response) - 2)
> ind_response = ind_response & "); " & vbCrLf &
> vbCrLf
>
> Case eVMEEREntityAnnotationUpperBound
> 'do nothing - not sure what this is for
>
> End Select
>
> 'Select the next index in the data vis_model
> Set vis_index = vis_indexes.Next
>
> Loop
>
> 'strip last , of the column/constraint list
> 'and terminate the CREATE TABLE statement
> response = Left(response, Len(response) - 5)
> response = response & ");" & vbCrLf & vbCrLf
>
> 'add the CREATE INDEX statements right after the table
> If write_indexes_flag = True Then
> response = response & ind_response
> End If
>
> End If
>
> Set vis_shape = vis_shapes.Next
>
> Loop
>
> 'End first pass, Set up for the second pass through the vis_model
> 'On Error GoTo RelErr
>
> Set vis_shapes = vis_model.elements
> Set vis_shape = vis_shapes.Next
>
> response = response & vbCrLf & "---------------------------
> FOREIGN KEYS ---------------------------" & vbCrLf & vbCrLf
>
> Do While Not vis_shape Is Nothing
>
> 'Have we got a relationship?
> If vis_shape.Type = eVMEKindERRelationship Then
>
> 'Add relationships
>
> Set vis_relationship = vis_shape
>
> 'Create Relationship
> constraint_name =
> Make_Name_SQL_Compatible(vis_relationship.PhysicalName)
> 'Specify the related / foreign table. (The parent table in
> VME)
> referencing_table_name =
> Make_Name_SQL_Compatible(vis_relationship.FirstEntity.PhysicalName)
> 'Specify the primary table. (The child table in VME)
> referenced_table_name =
> Make_Name_SQL_Compatible(vis_relationship.SecondEntity.PhysicalName)
>
> response = response & "ALTER TABLE " &
> referencing_table_name & " " & vbCrLf & _
> " ADD CONSTRAINT " & constraint_name
> & " " & vbCrLf & _
> " FOREIGN KEY ("
>
> 'Add the columns to the relationship
>
> 'Read Foreign table columns
> Set vis_referencing_columns =
> vis_relationship.FirstAttributes
> Set vis_referencing_column = vis_referencing_columns.Next
>
> Do While Not vis_referencing_column Is Nothing
>
> response = response &
> Make_Name_SQL_Compatible(vis_referencing_column.PhysicalName) & ", "
> 'Repeat for other columns if a multi-column relation.
> Set vis_referencing_column =
> vis_referencing_columns.Next
>
> Loop
>
> 'strip last ,
> response = Left(response, Len(response) - 2)
> response = response & ")" & vbCrLf
>
>
> 'Read Primary table columns
> Set vis_referenced_columns =
> vis_relationship.SecondAttributes
> Set vis_referenced_column = vis_referenced_columns.Next
>
> response = response & " REFERENCES " &
> referenced_table_name & " ("
>
> Do While Not vis_referenced_column Is Nothing
>
> response = response &
> Make_Name_SQL_Compatible(vis_referenced_column.PhysicalName) & ", "
> 'Repeat for other columns if a multi-column relation.
> Set vis_referenced_column =
> vis_referenced_columns.Next
>
> Loop
>
> 'strip last ,
> response = Left(response, Len(response) - 2)
> response = response & ")" & vbCrLf
>
> 'define update and delete rules
> Select Case vis_relationship.UpdateRule
> Case eVMERIRuleCascade
> response = response & " ON UPDATE CASCADE" &
> vbCrLf
> Case eVMERIRuleSetNull
> response = response & " ON UPDATE SET NULL" &
> vbCrLf
> Case eVMERIRuleSetDefault
> response = response & " ON UPDATE SET DEFAULT" &
> vbCrLf
> Case eVMERIRuleNoAction
> 'ON UPDATE RESTRICT is standard - must not mention
> End Select
>
> Select Case vis_relationship.DeleteRule
> Case eVMERIRuleCascade
> response = response & " ON DELETE CASCADE" &
> vbCrLf
> Case eVMERIRuleSetNull
> response = response & " ON DELETE SET NULL" &
> vbCrLf
> Case eVMERIRuleSetDefault
> response = response & " ON DELETE SET DEFAULT" &
> vbCrLf
> Case eVMERIRuleNoAction
> 'ON DELETE RESTRICT is standard - must not mention
> End Select
>
> 'strip last crlf of the column list
> response = Left(response, Len(response) - 2)
> response = response & ";" & vbCrLf & vbCrLf
>
> End If
>
> Set vis_shape = vis_shapes.Next
>
> Loop
>
> 'Write the resulte to file and close it
> Print #1, response
> Close (1)
>
>
> Exit Sub
>
> TblErr:
> Debug.Print "Tbl Err"
> Debug.Print " "
> Resume Next
>
> IndErr:
> Debug.Print vis_table_def.PhysicalName, vis_index.PhysicalName,
> Err.Description, "Idx Err"
> Debug.Print " "
> Resume Next
>
> RelErr:
> Debug.Print vis_relationship.SecondEntity.PhysicalName,
> vis_relationship.FirstEntity.PhysicalName, Err.Description, "Rel Err"
> Debug.Print " "
> Resume Next
>
> End Sub
>
> 'Description: Handle white spaces in object names
> 'Author: PP 2010-04-06
> Private Function Make_Name_SQL_Compatible(ByVal object_name As String)
> As String
>
> If InStr(1, object_name, " ") > 0 Then
> 'for table names with spaces in it
> 'as per ANSI, use double quotes
> 'SQL Server uses [], but can be set to double quotes - SET
> QUOTED_IDENTIFIER ON
> object_name = """" & object_name & """"
> End If
>
> Make_Name_SQL_Compatible = object_name
>
> End Function 

> But how do I run it? =A0Do I need to install it? <

This is a VBA macro for Visio 2003. You need to put it into each
drawing for which you would like to use it. Put the code into a new
module in the *.vsd Visio
drawing and run it from the macros menu.

Might be a com-add in could be created from it, but I have not checked
into it. If you have good old VB 6 compiler, time and patience you
could give it a try. The advantage would be to have it once on one
machine only as a .dll installed.

brgds

Philipp Post

Sounds good.

I will try that tonight.

Thanks,

Tom
"Philipp Post" <post.philipp@googlemail.com> wrote in message 
news:11da5ca9-2f61-486d-afdd-a280739a8560@n3g2000yqb.googlegroups.com...
> But how do I run it? Do I need to install it? <

This is a VBA macro for Visio 2003. You need to put it into each
drawing for which you would like to use it. Put the code into a new
module in the *.vsd Visio
drawing and run it from the macros menu.

Might be a com-add in could be created from it, but I have not checked
into it. If you have good old VB 6 compiler, time and patience you
could give it a try. The advantage would be to have it once on one
machine only as a .dll installed.

brgds

Philipp Post