PLEASE HELP - Lost/Orphaned Item In My Database Model!!!

[David]

Somehow, my database model has a missing relationship. It causes an error
when trying to error-check and generate from the model. The diagram says it
is there but there seems to be no way to get at it. When I click on the error
in the output windows, it says that it cannot be displayed because the
entities to which it is attached are not on the diagram. I have put alot of
time and effort into this model and would be very angry if I cannot remove
this offending item and move forward. PLEASE HELP.

Thanks,

David

 

[Chang Oh]

You can run the following code from VBA to remove the orphaned
relationships.

Chang Oh
Visual Studio Enterprise Frameworks and Tools

' This is provided "AS IS" with no warranties, and
' confers no rights.
'
' This module removes all relationships that are NOT fully connected
' to either parent table or child table. The relationship may or may
' not visible. If you get
' filename : error L2100: FK name : Relationship is not fully connected.
' error messages and not able to locate it on the diagram, then this module
' will remove the relationships from the model.
'
' Follow the following steps
'
' Select "Tools"/"Macros"/"Visual Basic Editor" from the Visio menus.
' Select "Tools"/"References" from the Visual Basic editor.
' Check "Microsoft Visio Database Modeling Engine Type Library" and
' click the OK button.
' Copy this following subroutine into the text area under "(General)"
' Select "Run"/"Run Sub-UserForm" (or hit the play button)
' Close the Visual Basic editor
' Now select "Database"/"Model"/"Error Check"
'
Sub DeleteAllDisconnectedRelationshipsFromAllModels()

Dim vme As New VisioModelingEngine
Dim models As IEnumIVMEModels
Dim model As IVMEModel
Dim elements As IEnumIVMEModelElements
Dim element As IVMEModelElement
Dim relationship As IVMERelationship

Set models = vme.models
Set model = models.Next

Do While Not model Is Nothing
Set elements = model.elements
Set element = elements.Next

Do While Not element Is Nothing
If (element.Type = eVMEKindERRelationship) Then
Set relationship = element

If (Not relationship.IsFullyConnected) Then
model.DeleteElement element.ElementID
Set elements = model.elements
End If
End If

Set element = elements.Next
Loop

Set model = models.Next
Loop

End Sub