VBA Macro in Excel to replace drawing format to new company standard---Need help Please

[JanKirsten]

This is what I have so far. Problem comes in when trying to select & delete the format tables on each sheet. Been at this for 2 weeks already and probably have 2 more to go at this pace.

Any help would be greatly appreciated. Help files not very helpful.

Public Sub change_sheet_parameter()
        Dim conn As IpfcAsyncConnection
        Dim cAC As CCpfcAsyncConnection
        Dim CreoSession As IpfcBaseSession
        Dim CreoDRW As IpfcModel
        Dim sheetData As IpfcSheetData
        Dim sheetowner As IpfcSheetOwner
        Dim ModelItem As New CMpfcModelItem
        Dim sheetInfo As IpfcSheetInfo
       
        Dim paramOwn As IpfcParameterOwner
       
        Dim ipREVISION_LEVEL As IpfcParameter
        Dim ipbREVISION_LEVEL As IpfcBaseParameter
        Dim pnREVISION_LEVEL As String
        Dim REVISION_LEVELnv As IpfcParamValue
       
        Dim ipDRAWING_NUMBER As IpfcParameter
        Dim ipbDRAWING_NUMBER As IpfcBaseParameter
        Dim pnDRAWING_NUMBER As String
        Dim DRAWING_NUMBERnv As IpfcParamValue
       
        Dim ipRMSS_APPROVED As IpfcParameter
        Dim ipbRMSS_APPROVED As IpfcBaseParameter
        Dim pnRMSS_APPROVED As String
        Dim RMSS_APPROVEDnv As IpfcParamValue
       
        Dim ipRMSS_APPROVE_DATE As IpfcParameter
        Dim ipbRMSS_APPROVE_DATE As IpfcBaseParameter
        Dim pnRMSS_APPROVE_DATE As String
        Dim RMSS_APPROVE_DATEnv As IpfcParamValue
       
        Dim ipRMSS_CUSTOMER_REV As IpfcParameter
        Dim ipbRMSS_CUSTOMER_REV As IpfcBaseParameter
        Dim pnRMSS_CUSTOMER_REV As String
        Dim RMSS_CUSTOMER_REVnv As IpfcParamValue
       
        Dim ipRMSS_DRAWN_BY As IpfcParameter
        Dim ipbRMSS_DRAWN_BY As IpfcBaseParameter
        Dim pnRMSS_DRAWN_BY As String
        Dim RMSS_DRAWN_BYnv As IpfcParamValue
       
        Dim ipRMSS_ECO_NUM As IpfcParameter
        Dim ipbRMSS_ECO_NUM As IpfcBaseParameter
        Dim pnRMSS_ECO_NUM As String
        Dim TRMSS_ECO_NUMnv As IpfcParamValue
       
        Dim ipRMSS_ENGR As IpfcParameter
        Dim ipbRMSS_ENGR As IpfcBaseParameter
        Dim pnRMSS_ENGR As String
        Dim RMSS_ENGRnv As IpfcParamValue
       
        Dim ipRMSS_PART_NUM As IpfcParameter
        Dim ipbRMSS_PART_NUM As IpfcBaseParameter
        Dim pnRMSS_PART_NUM As String
        Dim RMSS_PART_NUMnv As IpfcParamValue
       
        Dim ipRMSS_REV As IpfcParameter
        Dim ipbRMSS_REV As IpfcBaseParameter
        Dim pnRMSS_REV As String
        Dim RMSS_REVnv As IpfcParamValue
       
        Dim ipRMSS_REV_DESCR As IpfcParameter
        Dim ipbRMSS_REV_DESCR As IpfcBaseParameter
        Dim pnRMSS_REV_DESCR As String
        Dim TRMSS_REV_DESCRnv As IpfcParamValue
       
pnDRAWING_NUMBER = "DRAWING_NUMBER"
pnREVISION_LEVEL = "REVISION_LEVEL"
pnRMSS_APPROVED = "RMSS_APPROVED"
pnRMSS_APPROVE_DATE = "RMSS_APPROVE_DATE"
pnRMSS_CUSTOMER_REV = "RMSS_CUSTOMER_REV"
pnRMSS_DRAWN_BY = "RMSS_DRAWN_BY"
pnRMSS_ECO_NUM = "RMSS_ECO_NUM"
pnRMSS_ENGR = "RMSS_ENGR"
pnRMSS_PART_NUM = "RMSS_PART_NUM"
pnRMSS_REV = "RMSS_REV"
pnRMSS_REV_DESCR = "RMSS_REV_DESCR"

        
        Dim workDir As String
        Dim sFileName As String
   workDir = "C:\Users\jakirsten\Documents\Creo_TEMP"

'MsgBox "Run 01_PURGE_FIRST_Jan.exe First!!!"

Set cAC = New CCpfcAsyncConnection
Set conn = cAC.Connect("", "", ".", 5)
Set CreoSession = conn.session
CreoSession.ChangeDirectory (workDir)

Dim oModelDescriptorCreate As New CCpfcModelDescriptor
Dim oModelDescriptor As IpfcModelDescriptor
sFileName = Dir(CreoSession.GetCurrentDirectory & "\*.drw*")
'sFileName = "4360120-01.drw" 'Name of the drawing

Do Until sFileName = ""
        Debug.Print sFileName
        Set oModelDescriptor = oModelDescriptorCreate.Create(EpfcMDL_DRAWING, sFileName, Null)
        Set CreoDRW = CreoSession.RetrieveModel(oModelDescriptor)
        Set sheetowner = CreoDRW
        Dim oWindow As pfcls.IpfcWindow
        Set oWindow = CreoSession.OpenFile(oModelDescriptor)
        oWindow.Activate
        'sheetowner.RegenerateSheet (1)
        Dim curSheetNum As Long
        Dim totalSheets As Long
        Dim sheetStep As Long
         curSheetNum = sheetowner.CurrentSheetNumber
         totalSheets = sheetowner.NumberOfSheets
        
         For sheetStep = curSheetNum To totalSheets
            Dim tableObj As IpfcTableOwner
            Dim tableToDelete As IpfcTableOwner
            Dim table_list As CpfcTables
            Dim tableInfo As CpfcTable
            Dim CurTABLE As IpfcTable
            Dim tblCount, tblStp As Integer
           
            Set tableObj = sheetowner
            Set table_list = tableObj.ListTables
           
                tblCount = table_list.Count
           
            For tblStp = 0 To tblCount - 1
                Set CurTABLE = table_list.item(tblStp)
               ' Set tableToDelete = CurTABLE
                'tableInfo = CurTABLE
                'Debug.Print tableInfo.GetName & " is table name"
                If (CurTABLE.CheckIfIsFromFormat(sheetStep) = True And CurTABLE.GetSegmentSheet(0) = sheetStep) Then
               
                   'Set tableToDelete = CurTABLE
                    'tabletodelete.DeleteTable(CurTABLE, False) <-------------------------------------Cannot get this to work
                    Debug.Print tblStp & " is a format table"
                Else
                    Debug.Print tblStp & " NOT A FORMAT TABLE"
                End If
               
                tblStp = tblStp + 1
            Next tblStp
            tblStp = 0
        
         Next sheetStep
         sheetStep = 0
        
       
       
       
       
        Set paramOwn = CreoDRW
       
'        Set ipTITLE1 = paramOwn.GetParam(pnTITLE1)
'        Set ipbTITLE1 = ipTITLE1
       
        Set ipREVISION_LEVEL = paramOwn.GetParam(pnREVISION_LEVEL)
        Set ipbREVISION_LEVEL = ipREVISION_LEVEL
       
        Set ipDRAWING_NUMBER = paramOwn.GetParam(pnDRAWING_NUMBER)
        Set ipbDRAWING_NUMBER = ipDRAWING_NUMBER
       
        Set ipRMSS_APPROVED = paramOwn.GetParam(pnRMSS_APPROVED)
        Set ipbRMSS_APPROVED = ipRMSS_APPROVED
       
        Set ipRMSS_APPROVE_DATE = paramOwn.GetParam(pnRMSS_APPROVE_DATE)
        Set ipbRMSS_APPROVE_DATE = ipRMSS_APPROVE_DATE
       
        Set ipRMSS_CUSTOMER_REV = paramOwn.GetParam(pnRMSS_CUSTOMER_REV)
        Set ipbRMSS_CUSTOMER_REV = ipRMSS_CUSTOMER_REV
     
        Set ipRMSS_DRAWN_BY = paramOwn.GetParam(pnRMSS_DRAWN_BY)
        Set ipbRMSS_DRAWN_BY = ipRMSS_DRAWN_BY
       
        Set ipRMSS_ECO_NUM = paramOwn.GetParam(pnRMSS_ECO_NUM)
        Set ipbRMSS_ECO_NUM = ipRMSS_ECO_NUM
       
        Set ipRMSS_ENGR = paramOwn.GetParam(pnRMSS_ENGR)
        Set ipbRMSS_ENGR = ipRMSS_ENGR
       
        Set ipRMSS_PART_NUM = paramOwn.GetParam(pnRMSS_PART_NUM)
        Set ipbRMSS_PART_NUM = ipRMSS_PART_NUM
       
        Set ipRMSS_ENGR = paramOwn.GetParam(pnRMSS_ENGR)
        Set ipbRMSS_ENGR = ipRMSS_ENGR
       
        Set ipRMSS_REV = paramOwn.GetParam(pnRMSS_REV)
        Set ipbRMSS_REV = ipRMSS_REV
       
        Set ipRMSS_REV_DESCR = paramOwn.GetParam(pnRMSS_REV_DESCR)
        Set ipbRMSS_REV_DESCR = ipRMSS_REV_DESCR
       
        Set DRAWING_NUMBERnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B9").Value)
        Set REVISION_LEVELnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B10").Value)
        Set RMSS_APPROVEDnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B11").Value)
        Set RMSS_APPROVE_DATEnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B12").Value)
        Set RMSS_CUSTOMER_REVnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B13").Value)
        Set RMSS_DRAWN_BYnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B14").Value)
        Set RMSS_ECO_NUMnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B15").Value)
        Set RMSS_ENGRnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B16").Value)
        Set RMSS_PART_NUMnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B17").Value)
        Set RMSS_REVnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B18").Value)
        Set RMSS_REV_DESCRnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B19").Value)
               
        ipbDRAWING_NUMBER.Value = DRAWING_NUMBERnv
        ipbREVISION_LEVEL.Value = REVISION_LEVELnv
        ipbRMSS_APPROVED.Value = RMSS_APPROVEDnv
        ipbRMSS_APPROVE_DATE.Value = RMSS_APPROVE_DATEnv
        ipbRMSS_CUSTOMER_REV.Value = RMSS_CUSTOMER_REVnv
        ipbRMSS_DRAWN_BY.Value = RMSS_DRAWN_BYnv
        ipbRMSS_ECO_NUM.Value = RMSS_ECO_NUMnv
        ipbRMSS_ENGR.Value = RMSS_ENGRnv
        ipbRMSS_PART_NUM.Value = RMSS_PART_NUMnv
        ipbRMSS_REV.Value = RMSS_REVnv
        ipbRMSS_REV_DESCR.Value = RMSS_REV_DESCRnv
      

      
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
        oWindow.Close
        'CreoSession.EraseUndisplayedModels
        sFileName = Dir

Loop

'End the Creo Parametric session when done
''''If Not conn Is Nothing Then
''''    If conn.IsRunning Then
''''        conn.End
''''    End If
''''End If
''''RunError:
''''    If Err.Number <> 0 Then
''''        MsgBox "Process Failed : Unknown error occured." + Chr(13) + _
''''        "Error No: " + CStr(Err.Number) + Chr(13) + _
''''        "Error: " + Err.Description, vbCritical, "Error"
''''        If Not conn Is Nothing Then
''''            If conn.IsRunning Then
''''            conn.End
''''            End If
''''        End If
''''    End If
   
Set cAC = Nothing
Set conn = Nothing
Set CreoSession = Nothing
Set CreoDRW = Nothing
End Sub

[RandyJones]

---

                If (CurTABLE.CheckIfIsFromFormat(sheetStep) = True And CurTABLE.GetSegmentSheet(0) = sheetStep) Then
               
                   'Set tableToDelete = CurTABLE
                    'tabletodelete.DeleteTable(CurTABLE, False) <-------------------------------------Cannot get this to work

---

You need to delete the table from the drawing. The table object (at least in jlink and weblink) does not have a delete method. ie

CreoDRW .DeleteTable(CurTABLE, False)

[JanKirsten]

Hi Randy,

Thanks for the rely. Been looking at this all day now. Can't seem to find a way to relate the Drawing to the Active model.

Tried

Dim thisDrawing As CpfcDrawing

.

.

Set thisDrawing = CreoSession.GetActiveModel

but gives a type mismatch

Do you know if I have to do it by Id maybe? As you probably suspect I am not very well versed in Creo VB API, it is a lot different from the Solidworks macros and Excel VBA

Will keep on digging.

Thanks

Jan

[RandyJones]

I have never used vba. Instead either jlink or weblink. In jlink to have a drawing you would type the Model to a Drawing eg:

Session session = pfcGlobal.GetProESession();
Model currentModel = session.GetCurrentModel();//returns a Model
Drawing drawing = (Drawing)currentModel;//type the Model to a Drawing

[JanKirsten · Accepted solution]

After fighting this for 4 weeks finally got it solved. Had a lot of help from Liu at PTC tech support. Sharing so if someone wants to do the same thing, then he/she would not have to re-invent the wheel. This works on Creo 3.0. using Excel VBA.

Public Sub ReplaceSheetFormats()
   
    'On Error GoTo RunError 'and run KillCreoAfterCrash1
       
        'MsgBox "Run 01_PURGE_FIRST_Jan.exe First!!!" '<----------------------- Would like to run a PURGE on this directory before everything started but suspect something is wron in my settings. Is there an easy way to do??
       
        '------Setup connection to Creo
        Dim conn As IpfcAsyncConnection
        Dim cAC As CCpfcAsyncConnection
        Dim CreoSession As IpfcBaseSession
            Set cAC = New CCpfcAsyncConnection
            Set conn = cAC.start("C:\Program Files\PTC\Creo 3.0\M070\Parametric\bin\parametric.exe", Null)
            Set CreoSession = conn.session
        Dim workDir As String
            workDir = "C:\Users\jakirsten\Documents\Creo_TEMP"
            CreoSession.ChangeDirectory (workDir)
        '-----Connected & changed working directory
       
'        Dim dwFilesLists As Istringseq
'            Set dwFilesLists = CreoSession.ListFiles("*.drw", EpfcFILE_LIST_LATEST, workDir)
        Dim sFileName As String
           sFileName = Dir(CreoSession.GetCurrentDirectory & "\*.drw*")
            'sFileName = "4360120-01.drw" 'Name of the drawing
       
Do Until sFileName = ""   'See Loop down below all this is done on each drawing in the directory
        'Debug.Print sFileName
        Dim descModelCreate As CCpfcModelDescriptor
        Dim descModel As IpfcModelDescriptor
        Dim CreoModel As IpfcModel
            Set descModelCreate = New CCpfcModelDescriptor
            Set descModel = descModelCreate.Create(EpfcModelType.EpfcMDL_DRAWING, sFileName, Null)
            Set CreoModel = CreoSession.RetrieveModel(descModel)
       
        Dim oWindow As pfcls.IpfcWindow
            Set oWindow = CreoSession.OpenFile(descModel)
            oWindow.Activate
       
        Dim thisDrawingName As String
            thisDrawingName = CreoModel.CommonName
       
        'VB api process calls and other processing to be done
        Dim sheetOwner As IpfcSheetOwner
        Dim sheetInfo As IpfcSheetInfo
        Dim totalSheets As Long
        Dim sheetStep As Long
            Set sheetOwner = CreoModel
            totalSheets = sheetOwner.NumberOfSheets
           
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
           
        'First delete all format tables from all sheets
        Dim tableOwner As IpfcTableOwner
        Set tableOwner = CreoSession.CurrentModel
   
        Dim tables As IpfcTables
        Set tables = tableOwner.ListTables()
       
        Dim i As Integer
        For i = 0 To tables.Count - 1
            If tables.item(i).CheckIfIsFromFormat(i) = True Then
                tableOwner.DeleteTable tables.item(i), True  '<-------------------Thank you so much Frank you are a genius!!! it works great!!!
            End If
        Next i
          Set tables = tableOwner.ListTables() 'just to check tables has been deleted

'++++++++++++++++++++++++Deleting balloons+++++++++++++++++++++++++++++++ Code from Frank Liu....thank you
    Dim mdlItemOwner As IpfcModelItemOwner
        Set mdlItemOwner = CreoSession.CurrentModel
    Dim symInsts As IpfcModelItems
        Set symInsts = mdlItemOwner.ListItems(EpfcModelItemType.EpfcITEM_DTL_SYM_INSTANCE)
   
    For i = 0 To symInsts.Count - 1
        Dim symInst As IpfcDetailSymbolInstItem
            Set symInst = symInsts.item(i)
       
        Dim symInstDefName As String
        symInstDefName = symInst.GetInstructions(False).symbolDef.GetInstructions().name
        'If symInstDefName Like "*REV*" Then
        If StrComp(UCase(symInstDefName), "REV", vbTextCompare) = 0 Then
            On Error Resume Next
            symInst.Remove
            On Error GoTo 0
        End If
Next
'++++++++++++++++++++++++Deleting balloons+++++++++++++++++++++++++++++++
       
        'Now set parameters for sheetformat: ECO, dates, engineer,... and all that
    'From Medtronic parameters 3/22/18
    'WM=Windchill rev & not editable
    'PTC_WM_REVISION same as REVISION_LEVEL
    'REVISION_LEVEL   ---- is it safe to use this?
    'DRAWING_NUMBER ----not neccisarily Part Number----find partnumber variable!
    '&DRAWING_NUMBER:D   --- is this the exact variable?
    'ITEM_DESCRIPTION
       
        Dim paramOwn As IpfcParameterOwner
            Set paramOwn = CreoModel
        Dim CreoModelItem As CMpfcModelItem
            Set CreoModelItem = New CMpfcModelItem
        Dim ListTheseParameters As IpfcParameters
            Set ListTheseParameters = paramOwn.ListParams
       'First read the current rev from the drawing
'        Dim MedtrWindchillRev As IpfcParameter
'            Set MedtrWindchillRev = paramOwn.GetParam("PTC_WM_REVISION")
        Dim MedtrStatedRev As IpfcParameter
            Set MedtrStatedRev = paramOwn.GetParam("REVISION_LEVEL")
'------------------now create & set rmss parameters
        Dim ipRMSS_APPROVED As IpfcParameter
        Dim ipbRMSS_APPROVED As IpfcBaseParameter
        Dim pnRMSS_APPROVED As String
            pnRMSS_APPROVED = "RMSS_APPROVED"
        Dim RMSS_APPROVEDnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_APPROVED) Is Nothing Then
                Set RMSS_APPROVEDnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B13").Value)
                Set ipbRMSS_APPROVED = paramOwn.CreateParam(pnRMSS_APPROVED, RMSS_APPROVEDnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_APPROVED = paramOwn.GetParam(pnRMSS_APPROVED)
                Set RMSS_APPROVEDnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B13").Value)
                    ipRMSS_APPROVED.SetScaledValue RMSS_APPROVEDnv, Nothing
            End If

        Dim ipRMSS_APPROVE_DATE As IpfcParameter
        Dim ipbRMSS_APPROVE_DATE As IpfcBaseParameter
        Dim pnRMSS_APPROVE_DATE As String
            pnRMSS_APPROVE_DATE = "RMSS_APPROVE_DATE"
        Dim RMSS_APPROVE_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_APPROVE_DATE) Is Nothing Then
                Set RMSS_APPROVE_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B14").Value)
                Set ipbRMSS_APPROVE_DATE = paramOwn.CreateParam(pnRMSS_APPROVE_DATE, RMSS_APPROVE_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_APPROVE_DATE = paramOwn.GetParam(pnRMSS_APPROVE_DATE)
                Set RMSS_APPROVE_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B14").Value)
                    ipRMSS_APPROVE_DATE.SetScaledValue RMSS_APPROVE_DATEnv, Nothing
            End If

'        Dim ipRMSS_CUSTOMER_REV As IpfcParameter
'        Dim ipbRMSS_CUSTOMER_REV As IpfcBaseParameter
'        Dim pnRMSS_CUSTOMER_REV As String
'            pnRMSS_CUSTOMER_REV = "RMSS_CUSTOMER_REV"
'        Dim RMSS_CUSTOMER_REVnv As IpfcParamValue
'            If paramOwn.GetParam(pnRMSS_CUSTOMER_REV) Is Nothing Then
'                Set RMSS_CUSTOMER_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B9").Value)
'                Set ipbRMSS_CUSTOMER_REV = paramOwn.CreateParam(pnRMSS_CUSTOMER_REV, RMSS_CUSTOMER_REVnv)
'                Set ListTheseParameters = paramOwn.ListParams
'            End If
           
        Dim ipRMSS_DRAWN_BY As IpfcParameter
        Dim ipbRMSS_DRAWN_BY As IpfcBaseParameter
        Dim pnRMSS_DRAWN_BY As String
            pnRMSS_DRAWN_BY = "RMSS_DRAWN_BY"
        Dim RMSS_DRAWN_BYnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_DRAWN_BY) Is Nothing Then
                Set RMSS_DRAWN_BYnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B15").Value)
                Set ipbRMSS_DRAWN_BY = paramOwn.CreateParam(pnRMSS_DRAWN_BY, RMSS_DRAWN_BYnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_DRAWN_BY = paramOwn.GetParam(pnRMSS_DRAWN_BY)
                Set RMSS_DRAWN_BYnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B15").Value)
                    ipRMSS_DRAWN_BY.SetScaledValue RMSS_DRAWN_BYnv, Nothing
            End If

        Dim ipRMSS_DRAWN_DATE As IpfcParameter
        Dim ipbRMSS_DRAWN_DATE As IpfcBaseParameter
        Dim pnRMSS_DRAWN_DATE As String
            pnRMSS_DRAWN_DATE = "RMSS_DRAWN_DATE"
        Dim RMSS_DRAWN_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_DRAWN_DATE) Is Nothing Then
                Set RMSS_DRAWN_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B16").Value)
                Set ipbRMSS_DRAWN_DATE = paramOwn.CreateParam(pnRMSS_DRAWN_DATE, RMSS_DRAWN_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_DRAWN_DATE = paramOwn.GetParam(pnRMSS_DRAWN_DATE)
                Set RMSS_DRAWN_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B16").Value)
                    ipRMSS_DRAWN_DATE.SetScaledValue RMSS_DRAWN_DATEnv, Nothing
            End If

        Dim ipRMSS_ECO_NUM As IpfcParameter
        Dim ipbRMSS_ECO_NUM As IpfcBaseParameter
        Dim pnRMSS_ECO_NUM As String
            pnRMSS_ECO_NUM = "RMSS_ECO_NUM"
        Dim RMSS_ECO_NUMnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_NUM) Is Nothing Then
                Set RMSS_ECO_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B18").Value)
                Set ipbRMSS_ECO_NUM = paramOwn.CreateParam(pnRMSS_ECO_NUM, RMSS_ECO_NUMnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_NUM = paramOwn.GetParam(pnRMSS_ECO_NUM)
                Set RMSS_ECO_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B18").Value)
                    ipRMSS_ECO_NUM.SetScaledValue RMSS_ECO_NUMnv, Nothing
            End If
           
        Dim ipRMSS_ECO_DATE As IpfcParameter
        Dim ipbRMSS_ECO_DATE As IpfcBaseParameter
        Dim pnRMSS_ECO_DATE As String
            pnRMSS_ECO_DATE = "RMSS_ECO_DATE"
        Dim RMSS_ECO_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_DATE) Is Nothing Then
                Set RMSS_ECO_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B19").Value)
                Set ipbRMSS_ECO_DATE = paramOwn.CreateParam(pnRMSS_ECO_DATE, RMSS_ECO_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_DATE = paramOwn.GetParam(pnRMSS_ECO_DATE)
                Set RMSS_ECO_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B19").Value)
                    ipRMSS_ECO_DATE.SetScaledValue RMSS_ECO_DATEnv, Nothing
            End If
           
        Dim ipRMSS_ECO_ENGR As IpfcParameter
        Dim ipbRMSS_ECO_ENGR As IpfcBaseParameter
        Dim pnRMSS_ECO_ENGR As String
            pnRMSS_ECO_ENGR = "RMSS_ECO_ENGR"
        Dim RMSS_ECO_ENGRnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_ENGR) Is Nothing Then
                Set RMSS_ECO_ENGRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B20").Value)
                Set ipbRMSS_ECO_ENGR = paramOwn.CreateParam(pnRMSS_ECO_ENGR, RMSS_ECO_ENGRnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_ENGR = paramOwn.GetParam(pnRMSS_ECO_ENGR)
                Set RMSS_ECO_ENGRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B20").Value)
                    ipRMSS_ECO_ENGR.SetScaledValue RMSS_ECO_ENGRnv, Nothing
            End If

'        Dim ipRMSS_PART_NUM As IpfcParameter
'        Dim ipbRMSS_PART_NUM As IpfcBaseParameter
'        Dim pnRMSS_PART_NUM As String
'            pnRMSS_PART_NUM = "RMSS_PART_NUM"
'        Dim RMSS_PART_NUMnv As IpfcParamValue
'            If paramOwn.GetParam(pnRMSS_PART_NUM) Is Nothing Then
'                Set RMSS_PART_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B11").Value)
'                Set ipbRMSS_PART_NUM = paramOwn.CreateParam(pnRMSS_PART_NUM, RMSS_PART_NUMnv)
'                Set ListTheseParameters = paramOwn.ListParams
'            End If

        Dim ipRMSS_REV As IpfcParameter
        Dim ipbRMSS_REV As IpfcBaseParameter
        Dim pnRMSS_REV As String
            pnRMSS_REV = "RMSS_REV"
        Dim RMSS_REVnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_REV) Is Nothing Then
                Set RMSS_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B21").Value)
                Set ipbRMSS_REV = paramOwn.CreateParam(pnRMSS_REV, RMSS_REVnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_REV = paramOwn.GetParam(pnRMSS_REV)
                Set RMSS_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B21").Value)
                    ipRMSS_REV.SetScaledValue RMSS_REVnv, Nothing
            End If
       
        Dim ipRMSS_REV_DESCR As IpfcParameter
        Dim ipbRMSS_REV_DESCR As IpfcBaseParameter
        Dim pnRMSS_REV_DESCR As String
            pnRMSS_REV_DESCR = "RMSS_REV_DESCR"
        Dim RMSS_REV_DESCRnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_REV_DESCR) Is Nothing Then
                Set RMSS_REV_DESCRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B22").Value)
                Set ipbRMSS_REV_DESCR = paramOwn.CreateParam(pnRMSS_REV_DESCR, RMSS_REV_DESCRnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_REV_DESCR = paramOwn.GetParam(pnRMSS_REV_DESCR)
                Set RMSS_REV_DESCRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B22").Value)
                    ipRMSS_REV_DESCR.SetScaledValue RMSS_REV_DESCRnv, Nothing
            End If
           
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
       
                 'Now delete & replace sheet formats from each sheet
         For sheetStep = 1 To totalSheets
                Dim modelDesc As CCpfcModelDescriptor
                Set modelDesc = New CCpfcModelDescriptor
                Dim formatMdlDesc As IpfcModelDescriptor
                    Set formatMdlDesc = modelDesc.CreateFromFileName("rmss-medtronic-11x17-pg1andpg2.frm")
                Dim formatMdl As IpfcDrawingFormat
                    Set formatMdl = CreoSession.RetrieveModel(formatMdlDesc)
                If sheetStep = 1 Then
                    sheetOwner.SetSheetFormat 1, formatMdl, 1, CreoSession.CurrentModel
                Else
                    sheetOwner.SetSheetFormat sheetStep, formatMdl, 2, CreoSession.CurrentModel
                End If
         Next sheetStep
         sheetStep = 0
       
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
        
       

[JanKirsten]

page 2 of the code:

 CreoModel.Save  'Save the converted drawing in Creo format
       
        'Save rmss drawing as pdf
        Dim PDFExportInstrCreate As New CCpfcPDFExportInstructions
        Dim PDFExportInstr As IpfcPDFExportInstructions
            Set PDFExportInstr = PDFExportInstrCreate.Create
        Dim PDF_Options As New pfcls.CpfcPDFOptions

        ' Set Stroke All Fonts PDF Option
        Dim PDFOptionCreate_SAF As New CCpfcPDFOption
        Dim PDFOption_SAF As IpfcPDFOption
            Set PDFOption_SAF = PDFOptionCreate_SAF.Create
            PDFOption_SAF.OptionType = EpfcPDFOptionType.EpfcPDFOPT_FONT_STROKE
        Dim newArg_SAF As New CMpfcArgument
            PDFOption_SAF.OptionValue = newArg_SAF.CreateIntArgValue(EpfcPDFFontStrokeMode.EpfcPDF_STROKE_ALL_FONTS)
         Call PDF_Options.Append(PDFOption_SAF)

        ' Set COLOR_DEPTH value (Set EpfcPDF_CD_MONO to have Black & White output)
        Dim PDFOptionCreate_CD As New CCpfcPDFOption
        Dim PDFOption_CD As IpfcPDFOption
            Set PDFOption_CD = PDFOptionCreate_CD.Create
            PDFOption_CD.OptionType = EpfcPDFOptionType.EpfcPDFOPT_COLOR_DEPTH
        Dim newArg_CD As New CMpfcArgument
            PDFOption_CD.OptionValue = newArg_CD.CreateIntArgValue(EpfcPDFColorDepth.EpfcPDF_CD_COLOR)
            Call PDF_Options.Append(PDFOption_CD)

        ' Set PDF EpfcPDFOPT_LAUNCH_VIEWER(Set FALSE Not to Launch Adobe reader)
        Dim PDFOptionCreate_LV As New CCpfcPDFOption
        Dim PDFOption_LV As IpfcPDFOption
            Set PDFOption_LV = PDFOptionCreate_LV.Create
            PDFOption_LV.OptionType = EpfcPDFOptionType.EpfcPDFOPT_LAUNCH_VIEWER
        Dim newArg_LV As New CMpfcArgument
            PDFOption_LV.OptionValue = newArg_LV.CreateBoolArgValue(False)
            Call PDF_Options.Append(PDFOption_LV)

        'Set Output PDF File Name
        Dim SavePDFpath As String
        SavePDFpath = workDir & "\" & CreoModel.FullName & "_rmss_A"   'Creo does not allow spaces in even the pdf file names hence the underscores
        PDFExportInstr.Filepath = SavePDFpath
        PDFExportInstr.options = PDF_Options
        CreoModel.Export PDFExportInstr.Filepath, PDFExportInstr
           
        oWindow.Close
        CreoSession.EraseUndisplayedModels '<------Frank Liu Corrected me now works
        sFileName = Dir

Loop   ' go to the next drawing in the list and repeat

'End the Creo Parametric session when done
    If conn.IsRunning Then
        conn.End
    End If
   
    MsgBox "All Files Converted"
    Set cAC = Nothing
    Set conn = Nothing
    Set CreoSession = Nothing
    Set CreoModel = Nothing
    End
RunError:
    KillCreoAfterCrash1
   
Set cAC = Nothing
Set conn = Nothing
Set CreoSession = Nothing
Set CreoModel = Nothing
End Sub

Sub KillCreoAfterCrash1()

    MsgBox "There has been an Error"

    Dim IpfcAsyncConKAC As IpfcAsyncConnection
    Dim CCpfcAsyncConnKAC As New CCpfcAsyncConnection
    Set IpfcAsyncConKAC = CCpfcAsyncConnKAC.Connect(Null, Null, Null, Null)
        If IpfcAsyncConKAC.IsRunning Then
            IpfcAsyncConKAC.End
        End If
    Set IpfcAsyncConKAC = Nothing
    Set CCpfcAsyncConnKAC = Nothing
End Sub