We're using PowerDesigner v15.1. I wonder if anyone has a
VBS
that can create new Data Items in a CDM from an Excel
spreadsheet that they'd be willing to share.
Thanks. Patty
Do not judge this on it's proficiency as a program. I whipped this up
on Friday night before the long holiday weekend.
Option Explicit
Dim nb, mdl
Set mdl = Activemodel
Dim excel, wb, ws
Set excel = CreateObject("Excel.Application")
Set wb = excel.Workbooks.Open("C:\data\Critical Field
MappingUpdated6.xlsx", false, true)
Dim objWorksheet
Set objWorksheet = wb.Worksheets(1)
NB = 2
DIM oFT, oCol, bool
While LEN(objWorksheet.Range("A"+Cstr(nb)).Value)>0 'NB < 30
' ========
' File Transfer
' ========
SET oFT =
AddOrGetEntity(objWorksheet.Range("B"+Cstr(nb)).Value)
oFT.StereoType = "File Transfer"
Set oCol =
AddOrGetColumn( objWorksheet.Range("A"+Cstr(nb)).Value, oFT)
' ========
'RMA Table
' ========
SET oFT =
AddOrGetEntity(objWorksheet.Range("D"+Cstr(nb)).Value)
oFT.StereoType = "RMA Entity"
Set oCol =
AddOrGetColumn( objWorksheet.Range("C"+Cstr(nb)).Value, oFT)
bool = oCol.SetNameToCode
'Required
IF objWorksheet.Range("E"+Cstr(nb)).Value = "Yes" THEN
oCol.SetExtendedAttribute "RMA Required", TRUE
'oCol.comment = "Required by RMA"
ELSE
oCol.SetExtendedAttribute "RMA Required", FALSE
END IF
'RMA Validation
IF objWorksheet.Range("F"+Cstr(nb)).Value = "Yes" THEN
oCol.SetExtendedAttribute "RMA Validated", TRUE
'oCol.comment = oCol.comment + VBCRLF + "Validated by RMA"
ELSE
oCol.SetExtendedAttribute "RMA Validated", FALSE
END IF
'Impact to Position
IF objWorksheet.Range("G"+Cstr(nb)).Value = "Yes" THEN
oCol.SetExtendedAttribute "Impact to Position", TRUE
'oCol.comment = "Impact to Position" + VBCRLF + VBCRLF +
oCol.comment
ELSE
oCol.SetExtendedAttribute "Impact to Position", FALSE
END IF
IF False then
' ========
'Siebel or L* Table
' ========
If Len(objWorksheet.Range("J"+Cstr(nb)).Value) > 0 THEN
SET oFT =
AddOrGetEntity(objWorksheet.Range("J"+Cstr(nb)).Value)
IF objWorksheet.Range("M"+Cstr(nb)).Value = "Siebel" THEN
oFT.StereoType = "Siebel Entity"
ELSE
oFT.StereoType = "Lodestar Entity"
END IF
Set oCol =
AddOrGetColumn( objWorksheet.Range("I"+Cstr(nb)).Value, oFT)
bool = oCol.SetNameToCode
oCol.SetExtendedAttribute "Screen Name",
objWorksheet.Range("H"+Cstr(nb)).Value
SELECT CASE objWorksheet.Range("K"+Cstr(nb)).Value
CASE "Yes"
oCol.SetExtendedAttribute "Audited", TRUE
CASE "No"
oCol.SetExtendedAttribute "Audited", FALSE
CASE ELSE
oCol.SetExtendedAttribute "Audit Comment",
objWorksheet.Range("K"+Cstr(nb)).Value
END SELECT
SELECT CASE objWorksheet.Range("L"+Cstr(nb)).Value
CASE "Yes"
oCol.SetExtendedAttribute "Restricted", TRUE
CASE "No"
oCol.SetExtendedAttribute "Restricted", FALSE
CASE ELSE
oCol.SetExtendedAttribute "Restriction Comment",
objWorksheet.Range("L"+Cstr(nb)).Value
END SELECT
ELSE
oCol.Comment = "Source: " +
objWorksheet.Range("M"+Cstr(nb)).Value + vbCRLF
oCol.Comment = oCol.Comment + "Field Name: " +
objWorksheet.Range("I"+Cstr(nb)).Value + vbCRLF
oCol.Comment = oCol.Comment + "Screen Name: " +
objWorksheet.Range("H"+Cstr(nb)).Value + vbCRLF
oCol.Comment = oCol.Comment + "Audited: " +
objWorksheet.Range("K"+Cstr(nb)).Value + vbCRLF
oCol.Comment = oCol.Comment + "Restricted: " +
objWorksheet.Range("L"+Cstr(nb)).Value + vbCRLF
oCol.Comment = oCol.Comment + "Who Can Edit: " +
objWorksheet.Range("N"+Cstr(nb)).Value + vbCRLF
'OUTPUT oCol.comment
END IF
End if
NB = NB + 1
Wend
set objWorksheet = nothing
Set wb = nothing
set excel = nothing
' ====================================== '
' ------------ Entities ---------------- '
' ====================================== '
Private function DoesEntityExist(sName)
Dim oEntity
For Each oEntity in mdl.Entities
If oEntity.Name = sName then
DoesEntityExist = TRUE
Exit Function
End If
Next
DoesEntityExist = FALSE
End Function
Private Function GetEntityByName (p_Name)
Dim oEntity
For Each oEntity in mdl.Entities
If UCase(oEntity.Name) = UCase(p_Name) then
Set GetEntityByName = oEntity
Exit Function
End If
Next
End Function
Public Function AddOrGetEntity( vEntity )
Dim oEntity, Bool
IF NOT DoesEntityExist( vEntity ) THEN
set oEntity = mdl.Entities.CreateNew
oEntity.Name = vEntity
Bool = oEntity.SetNameToCode()
ELSE
SET oEntity = GetEntityByName( vEntity )
END IF
SET AddOrGetEntity = oEntity
End Function
' ===================================== '
' ------------ Columns ---------------- '
' ===================================== '
Private function DoesColumnExist(sName, oEnt)
Dim oColumn
For Each oColumn in oEnt.Attributes
If ucase(oColumn.Name) = Ucase(sName) then
DoesColumnExist = TRUE
Exit Function
End If
Next
DoesColumnExist = FALSE
End Function
Private Function GetColumnByName (sName, oEnt)
Dim oColumn
For Each oColumn in oEnt.Attributes
If UCase(oColumn.Name) = UCase(sName) then
Set GetColumnByName = oColumn
Exit Function
End If
Next
End Function
Public Function AddOrGetColumn( sName, oEnt )
Dim oColumn, Bool
IF NOT DoesColumnExist( sName, oEnt ) THEN
set oColumn = oEnt.Attributes.CreateNew
oColumn.Name = sName
Bool = oColumn.SetNameToCode() ' Doesn't seem to be working
ELSE
SET oColumn = GetColumnByName( sName, oEnt )
END IF
SET AddOrGetColumn = oColumn
End Function