将数据库中表PBCATCOL的PBC_LABL字段的值反向到ＰＤＭ对应的ＮＡＭＥ

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch
Dim mdl ' the current model
' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
MsgBox "There is no current Model"
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
MsgBox "The current model is not an Physical Data model."
Else
ProcessFolder mdl
End If
' This routine copy name into code for each table, each column and each view
' of the current folder
Private sub ProcessFolder(folder)
dim ls_NameTemp
Dim Tab 'running table
for each Tab in folder.tables
if not tab.isShortcut then
'tab.code = tab.name

if instr(Tab.name," ") > 0 then
ls_NameTemp = Mid(Tab.name,1,instr(Tab.name," ") - 1 )
else
if instr(Tab.name,"　") > 0 then
ls_NameTemp = Mid(Tab.name,1,instr(Tab.name,"　") - 1 )
else
ls_NameTemp = Tab.name
end if
end if


if len(ls_NameTemp) < 8 then
Tab.name = ls_NameTemp + Space( 8 - len(ls_NameTemp) ) + Tab.code
else
Tab.name = ls_NameTemp + Space( 2 ) + Tab.code
'考虑名称相同出现的异常
end if
On Error Resume Next


Dim col ' running column
for each col in tab.columns
'col.code= col.name
if instr(col.name," ") > 0 then
ls_NameTemp = Mid(col.name,1,instr(col.name," ") - 1 )
else
if instr(col.name,"　") > 0 then
ls_NameTemp = Mid(col.name,1,instr(col.name,"　") - 1 )
else
ls_NameTemp = col.name
end if
end if

if len(ls_NameTemp) < 6 then
'col.name = ls_NameTemp + Space( (8 - len(ls_NameTemp)) * 2 ) + col.code
col.name = ls_NameTemp + left( "　　　　　　　　　　",6 - len(ls_NameTemp) ) + col.code
else
'col.name = ls_NameTemp + Space(2) + col.code
col.name = ls_NameTemp + left( "　　　　　　　　　　",1) + col.code

'考虑名称相同出现的异常
end if
On Error Resume Next

next
end if
next
Dim view 'running view
for each view in folder.Views
if not view.isShortcut then
'view.code = view.name

if instr(view.name," ") > 0 then
ls_NameTemp = Mid(view.name,1,instr(view.name," ") - 1 )
else
if instr(view.name,"　") > 0 then
ls_NameTemp = Mid(view.name,1,instr(view.name,"　") - 1 )
else
ls_NameTemp = view.name
end if
end if

if len(ls_NameTemp) < 8 then
view.name = ls_NameTemp + Space( 8 - len(ls_NameTemp) ) + view.code
else
view.name = ls_NameTemp + Space( 2 ) + view.code
'考虑名称相同出现的异常
end if
On Error Resume Next


end if
next
' go into the sub-packages
Dim f ' running folder
For Each f In folder.Packages
if not f.IsShortcut then
ProcessFolder f
end if
Next
end sub