“How can I get the Table(s) name(s) and Cloumn(s) of an object in a universe using VBA macro.”
"I have already used Dwayne Hoffpauir’s
VBA macro which gets class name and Object name and modified to get subclass and Select of the Object.
I tried to use some Object’s Class
Universe\Classes\Class\Objects\Object\Tables 
SeanBob 
(BOB member since 2004-05-03)
I have logic that i use for reporting to our DBA team:
What it basically does is execute a query against the repository for the universe names, and for each universe, I import,refresh it structure, and write out every table used in it… I’m sure it can be easily modified to spit out the columns.
here is a section of my logic:
Const strFolderPath As String = "C:\Report Debug Logs\" ' logging folder path
'*****************************************
'Procedure Name: LoadDataProvider
'Purpose: Create Designer object and load/import all universe and write all files to DP for reporting
'Author: jresendez
'Date/Time Created:6/27/2005 / 13:31
'*****************************************
Sub LoadDataProvider(dpInterface As DpVBAInterface)
10 On Error GoTo ErrorHandler
20 Call CheckForLoggingFolder
'**********************************
30 WriteLog ("Begin - LoadDataProvider")
'**********************************
40 Application.Interactive = False
Dim i As Integer 'loop index
Dim Col1 As DpVBAColumn 'a column in the microcube
Dim Col2 As DpVBAColumn 'a column in the microcube
Dim Col3 As DpVBAColumn 'a column in the microcube
Dim Col4 As DpVBAColumn 'a column in the microcube
Dim Col5 As DpVBAColumn 'a column in the microcube
Dim Col6 As DpVBAColumn 'a column in the microcube
Dim Cols As DpVBAColumns 'the columns of the microcube
Dim newCube As DpVBACube 'the microcube we're filling
50 Set newCube = dpInterface.DpVBACubes.Item(1) 'there is only one cube
60 Set Cols = newCube.DpVBAColumns 'reference the columns of the cube
70 Cols.SetNbColumns (6) 'how many columns in the cube?
80 IntCurrentRowPos = 1
90 Set Col1 = Cols.Item(1) 'look at the first column in the cube
100 Col1.Name = "BO_UNIVERSE" 'the name that appears in the report
110 Col1.Type = boCharacterObject 'what sort of information is it?
120 Col1.Qualification = boDimension 'dimension, detail or measure?
130 Set Col2 = Cols.Item(2) 'look at the first column in the cube
140 Col2.Name = "LIBRARY" 'the name that appears in the report
150 Col2.Type = boCharacterObject 'what sort of information is it?
160 Col2.Qualification = boDimension 'dimension, detail or measure?
170 Set Col3 = Cols.Item(3) 'look at the first column in the cube
180 Col3.Name = "FILE_NAME" 'the name that appears in the report
190 Col3.Type = boCharacterObject 'what sort of information is it?
200 Col3.Qualification = boDimension 'dimension, detail or measure?
210 Set Col4 = Cols.Item(4) 'look at the first column in the cube
220 Col4.Name = "BO_TABLE_ALIAS" 'the name that appears in the report
230 Col4.Type = boCharacterObject 'what sort of information is it?
240 Col4.Qualification = boDimension 'dimension, detail or measure?
250 Set Col5 = Cols.Item(5) 'look at the first column in the cube
260 Col5.Name = "RUN_DATE" 'the name that appears in the report
270 Col5.Type = boCharacterObject 'what sort of information is it?
280 Col5.Qualification = boDimension 'dimension, detail or measure?
290 Set Col6 = Cols.Item(6) 'look at the first column in the cube
300 Col6.Name = "RUN_TIME" 'the name that appears in the report
310 Col6.Type = boCharacterObject 'what sort of information is it?
320 Col6.Qualification = boDimension 'dimension, detail or measure?
Dim WrkMain As Workspace
Dim ConMain As Connection
Dim RsQry As Recordset
Dim Sql As String
Dim Rep As Report
'**********************************
330 WriteLog ("Connect to repository DB to retrieve universe list")
'**********************************
340 Set WrkMain = CreateWorkspace("ODBCWorkspace", "admin", "", dbUseODBC)
350 Set ConMain = WrkMain.OpenConnection("Publishers", dbDriverNoPrompt, False, "ODBC;DATABASE=mydatabase;UID=myuserid;PWD=password;DSN=mydsn")
360 Sql = " SELECT OBJ_UNV.M_UNI_C_FILENAME"
370 Sql = Sql & " ,OBJ_M.M_REPO_C_NAME "
380 Sql = Sql & " ,OBJ_CONN.M_CNTN_C_NAME "
390 Sql = Sql & " FROM DWUNIBO.OBJ_M_UNIVERSES OBJ_UNV"
400 Sql = Sql & " ,DWUNIBO.OBJ_M_REPOSITORY OBJ_M ,DWUNIBO.OBJ_M_CONNECTION OBJ_CONN "
410 Sql = Sql & " WHERE OBJ_UNV.M_UNI_N_REPOID = OBJ_M.M_REPO_N_ID "
420 Sql = Sql & " AND OBJ_M.M_REPO_N_CONNECTID = OBJ_CONN.M_CNTN_N_ID "
'430 Sql = Sql & " AND OBJ_CONN.M_CNTN_N_TYPE = 2 "
430 Sql = Sql & " AND OBJ_M.M_REPO_N_TYPE = 2 "
460 Sql = Sql & " ORDER BY OBJ_UNV.M_UNI_C_FILENAME ASC" '
470 Set RsQry = ConMain.OpenRecordset(Sql, dbOpenDynaset)
'**********************************
480 WriteLog ("Create Designer object")
'**********************************
Dim ObjDes As Designer.Application
490 Set ObjDes = New Designer.Application
500 ObjDes.Interactive = False
510 If Err.Number <> 0 Then
520 MsgBox "Can not create the designer object" + Chr(10) + Chr(13) + Err.Description, vbCritical
530 Exit Sub
540 End If
Dim ObjUniverse As Designer.Universe
'Dim ObjConnection As Designer.Connection
'**********************************
550 WriteLog ("Logging into Designer")
'**********************************
560 Call ObjDes.LoginAs("bosuper", "bo", False)
'**********************************
570 WriteLog ("Logged into Designer")
'**********************************
580 If Not RsQry.EOF Then
590 Do While Not RsQry.EOF
600 DomainName = RsQry.Fields("M_REPO_C_NAME")
610 UniverseName = RsQry.Fields("M_UNI_C_FILENAME")
620 ConnectionName = RsQry.Fields("M_CNTN_C_NAME")
Dim Y As Integer
Dim strUniverseName As String
Dim strCopyFromPath As String
Dim strCopyToPath As String
Dim strUniverseFullName As String
Dim strSourceDomain As String
630 strUniverseName = UniverseName
640 strUniverseName = strUniverseName & ".unv"
650 strCopyFromPath = ObjDes.GetInstallDirectory(dsUniverseDirectory) & "\" & DomainName & "\"
'**********************************
660 WriteLog ("Checking for existing copy of universe..")
'**********************************
'**********************************
670 WriteLog ("Importing Universe... [" & DomainName & " - " & UniverseName & "")
680 ObjDes.Application.Interactive = False
690 Call ObjDes.Universes.Import(DomainName, UniverseName, False)
700 ObjDes.Application.Interactive = True
'**********************************
710 WriteLog ("Import Complete")
'**********************************
'**********************************
720 WriteLog ("Initiate " & UniverseName & " then open")
'**********************************
730 ObjDes.Interactive = False
740 Set ObjUniverse = ObjDes.Universes.Open(strCopyFromPath & strUniverseName)
750 ObjDes.Interactive = True
760 WriteLog ("ConnectionName= " & ObjUniverse.Connection)
'**********************************
770 WriteLog (UniverseName & " open")
'**********************************
780 ObjDes.Application.Interactive = False
790 WriteLog ("Begin Refresh Stucture")
800 ObjDes.Universes.Application.ActiveUniverse.RefreshStructure
810 WriteLog ("End Refresh Stucture")
820 ObjDes.Application.Interactive = True
830 On Error GoTo ErrorHandler
'here is where i get the universe tables
840 For i = 1 To ObjUniverse.Tables.Count
Dim objTable As Designer.Table
850 Set objTable = ObjUniverse.Tables.Item(i)
860 If (objTable.IsAlias = False) And (InStr(1, ObjUniverse.Tables.Item(i).Name, ".") <> 0) Then
Here you can add the code to get your column names
maybe something like:
For x = 1 To ObjUniverse.Tables.Item(i).Columns.Count
MsgBox ObjUniverse.Tables.Item(i).Columns.Item(x).Name
Next x
and proceed to the next table(s)…etc
870 Call GetLibrary(ObjUniverse.Tables.Item(i).Name)
880 Call GetFileName(ObjUniverse.Tables.Item(i).Name)
890 blnCheckedEDI = False
900 Call GetSystemCatalog(strLibraryName, strFileName, "SOURCE_DB")
910 If blnFoundFile Then
920 Col1.Item(IntCurrentRowPos) = ObjUniverse.Name 'set the value to a number
930 Col2.Item(IntCurrentRowPos) = strSystemTableSchema 'set the value to a number
940 Col3.Item(IntCurrentRowPos) = str400FileName 'set the value to a number
950 Col4.Item(IntCurrentRowPos) = ObjUniverse.Tables.Item(i).Name 'set the value to a number
960 Col5.Item(IntCurrentRowPos) = strCurrentdate 'set the value to a number
970 Col6.Item(IntCurrentRowPos) = strCurrentTime 'set the value to a number
980 IntCurrentRowPos = IntCurrentRowPos + 1
990 End If
1000 Else
'**********************************
1010 WriteLog (UniverseName & "-- File " & ObjUniverse.Tables.Item(i).Name & " is an Alias Table OR it does not an applicable universe.")
'**********************************
1020 End If
1030 Next i
MoveNext:
1040 ObjDes.Interactive = False
1050 ObjUniverse.Save
1060 ObjDes.Interactive = True
1070 ObjUniverse.Close
'**********************************
1080 WriteLog ("Universe " & UniverseName & " has completed...")
'**********************************
ImportErrorSkip:
1090 RsQry.MoveNext
1100 Loop
1110 End If
'**********************************
1120 WriteLog ("Process Completed ")
'**********************************
'**********************************
1130 WriteLog ("Closing Designer Objects")
'**********************************
1140 ObjDes.Quit
1150 Set ObjDes = Nothing
'**********************************
1160 WriteLog ("Closing Database and Recordset connections")
'**********************************
1170 Set RsQry = Nothing
1180 ConMain.Close
1190 WrkMain.Close
'**********************************
1200 WriteLog ("Restoring Application.Interactive - TRUE")
'**********************************
1210 Application.Interactive = True
'**********************************
1220 WriteLog ("Exiting Subroutine")
'**********************************
1230 Exit Sub
ErrorHandler:
1240 Close #1
1250 WriteLog ("ERROR - " & CStr(Err.Number) & " (" & Err.Description & ") Error occured at line number - " & Erl)
1260 WriteLog ("Error Found, moving to next universe...")
1270 If Err.Number = 42 Then
1280 GoTo ImportErrorSkip
1290 End If
1300 GoTo MoveNext
End Sub
'WRITELOG
Function WriteLog(LogTxt As String, Optional EndProcessBrk As Boolean)
Dim doc As Document
Dim StrLogFile
If IsLoggingOn Then
Set doc = ActiveDocument
StrLogFile = strFolderPath & doc.Name & "_Audit_Log" & "_" & Format(Now(), "yyyy_mm_dd") & ".log"
Open StrLogFile For Append As #1
Print #1, Now() & " -- " & LogTxt & vbCrLf;
If EndProcessBrk Then
Print #1, vbCrLf & vbCrLf;
End If
Close #1
End If
Exit Function
End Function
Hope this helps…
I left out a few sections…but you should be able to get this up in running in your application.
jresendez 
(BOB member since 2004-05-03)
Here is another alternative. The utility posted here is from one of my conference presentations in 2004. It is a “read only” utility that will document pretty much an entire universe using Excel and the Designer SDK.
Dwayne Hoffpauir (BOB member since 2002-09-19)
Thank so very much jresendez and Dwayne Hoffpauir
“SHARE YOUR KNOWLEDGE. IT’S A WAY TO ACHIEVE IMMORTALITY”
SeanBob (BOB member since 2004-05-03)