Author: Dwayne Hoffpauir, EDS Corporation
Further discussion on this utility should take place in this topic.
Author Notes:
Option Explicit 'require variables to be declared before being used
Option Compare Text 'use case insensitive comparison
Sub GetLists()
Dim DesignerApp As Designer.Application
Dim Univ As Designer.Universe
Dim Tbl As Designer.Table
Dim Jn As Designer.Join
Dim Cont As Designer.Context
Dim Rng As Excel.Range
Dim RowNumTables As Long, RowNumJoins As Long, RowNumContexts As Long
Dim CurrentApp As String
Set DesignerApp = New Designer.Application
DesignerApp.Visible = True
Call DesignerApp.LoginAs
RowNumTables = 1: RowNumJoins = 1: RowNumContexts = 1
Set Univ = DesignerApp.Universes.Open
'get list of tables / aliases
Set Rng = Sheets("Tables").Cells
For Each Tbl In Univ.Tables
RowNumTables = RowNumTables + 1
Rng(RowNumTables, 1) = Tbl.Name
If Tbl.IsAlias Then
Rng(RowNumTables, 2) = Tbl.OriginalTable
End If
Next Tbl
'get list of joins
Set Rng = Sheets("Joins").Cells
For Each Jn In Univ.Joins
RowNumJoins = RowNumJoins + 1
Rng(RowNumJoins, 1) = Jn.Expression
Rng(RowNumJoins, 2) = Jn.ShortCut
Rng(RowNumJoins, 3) = Jn.Cardinality
Rng(RowNumJoins, 4) = Jn.OuterJoin
Next Jn
'get contexts
Set Rng = Sheets("Contexts").Cells
For Each Cont In Univ.Contexts
For Each Jn In Cont.Joins
RowNumContexts = RowNumContexts + 1
Rng(RowNumContexts, 1) = Cont.Name
Rng(RowNumContexts, 2) = Jn.Expression
Next Jn
Next Cont
DesignerApp.Quit
Set DesignerApp = Nothing
End Sub
Sub AddJoins()
Dim DesignerApp As Designer.Application
Dim Univ As Designer.Universe
Dim Jn As Designer.Join
Dim Rng As Excel.Range
Dim RowNum As Long
Set DesignerApp = New Designer.Application
DesignerApp.Visible = True
Call DesignerApp.LoginAs
Set Rng = Sheets("Joins").Cells
RowNum = 2
Set Univ = DesignerApp.Universes.Open
Do Until Rng(RowNum, 1) = ""
Set Jn = Univ.Joins.Add(Rng(RowNum, 1))
Jn.ShortCut = Rng(RowNum, 2)
Jn.Cardinality = Rng(RowNum, 3)
Jn.OuterJoin = Rng(RowNum, 4)
RowNum = RowNum + 1
Loop
End Sub
Sub AddJoinToContext()
Dim DesignerApp As Designer.Application
Dim Univ As Designer.Universe
Dim Jn As Designer.Join
Dim Cont As Designer.Context
Dim Rng As Excel.Range
Dim RowNum As Long
Set DesignerApp = New Designer.Application
DesignerApp.Visible = True
Call DesignerApp.LoginAs
Set Rng = Sheets("Contexts").Cells
RowNum = 2
Set Univ = DesignerApp.Universes.Open
Do Until Rng(RowNum, 1) = ""
For Each Cont In Univ.Contexts
If Cont.Name = Rng(RowNum, 1) Then
Call Cont.Joins.Add(Rng(RowNum, 2))
End If
Next Cont
RowNum = RowNum + 1
Loop
End Sub
JoinsContexts.zip (14.0 KB)
BOB Downloads (BOB member since 2003-05-05)