'******************************************************************************
'* File:
'* Purpose: Recursively searches all tables under the current PDM, and exports Excel
'* Title:
'* Category:
'* Version: 1.0
'* Author: huhaicool@
'******************************************************************************
Option Explicit
ValidationMode = True
InteractiveMode = im_Batch
' get the current active model
Dim mdl ' the current model
Set mdl = ActiveModel
Dim EXCEL,sheet,rowsNum
rowsNum = 1
If (mdl Is Nothing) Then
MsgBox "There is no Active Model"
Else
SetExcel
ListObjects(mdl)
End If
'-----------------------------------------------------------------------------
' Sub procedure to scan current package and print information on objects from current package
' and call again the same sub procedure on all children pacakge
' of the current package
'-----------------------------------------------------------------------------
Private Sub ListObjects(fldr)
output "Scanning " &
Dim obj ' running object
For Each obj In
' Calling sub procedure to print out information on the object
DescribeObject obj
Next
' go into the sub-packages
Dim f ' running folder
For Each f In
'calling sub procedure to scan children package
ListObjects f
Next
End Sub
'-----------------------------------------------------------------------------
' Sub procedure to print information on current object in output
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
if not (cls_NamedObject) then exit sub
if (cls_Table) then
ExportTable CurrentObject, sheet
else
output "Found "++" """+CurrentObject.Name+""", Created by "++" On "+Cstr()
End if
End Sub
Sub SetExcel()
Set EXCEL= CreateObject("")
' Make Excel visible through the Application object.
= True
(-4167)'Add worksheet
(1).sheets(1).name ="pdm"
set sheet = (1).sheets("pdm")
' Place some text in the first Row of the sheet.
(rowsNum, 1).Value = "Table Name"
(rowsNum, 2).Value = "Table Chinese name"
(rowsNum, 3).Value = "Table Notes"
(rowsNum, 4).Value = "Field ID"
(rowsNum, 5).Value = "Field Name"
(rowsNum, 6).Value = "Chinese name of field"
(rowsNum, 7).Value = "Field Type"
(rowsNum, 8).Value = "Field Notes"
End Sub
Sub ExportTable(tab, sheet)
Dim col ' running column
Dim colsNum
colsNum = 0
for each col in tab.columns
colsNum = colsNum + 1
rowsNum = rowsNum + 1
(rowsNum, 1).Value = tab.code
(rowsNum, 2).Value = tab.name
(rowsNum, 3).Value = tab.comment
(rowsNum, 4).Value = colsNum
(rowsNum, 5).Value =
(rowsNum, 6).Value = col.name
(rowsNum, 7).Value =
(rowsNum, 8).Value =
next
output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub
