load & activate a model from VB (2) 1

Option Explicit
'<><><><><><><><><><><><><><>
' Transfer Custom Properties
'<><><><><><><><><><><><><><>
Dim swApp As Object
Dim Dwg As Object
Dim View As Object
Dim Model As Object

Const swDocDRAWING = 3

Dim sModelName As String
Dim sPartName As String
Dim sDwgName As String

Sub Main()
    Dim swError As Long, iPos As Long, bClose As Boolean
    Dim sTitle As String
    Set swApp = CreateObject(&quot;SldWorks.Application&quot;)
    Set Dwg = swApp.ActiveDoc
    'Verify a Drawing is Open
    If (Dwg Is Nothing) Or (Dwg.GetType <> swDocDRAWING) Then
        swApp.SendMsgToUser &quot;You Must Have a Drawing Opened&quot;
        Exit Sub
    End If
    sDwgName = Dwg.GetTitle
    'Get Reference Model
    Set View = Dwg.GetFirstView    'drawing template
    Set View = View.GetNextView     'first drawing view
    sModelName = View.GetReferencedModelName()
    'Open the Reference Model, read the custom properties, save and close the model
    'Switch to the model if it is already opened
    sPartName = sModelName
    iPos = InStr(1, sPartName, &quot;\&quot;)
    Do While iPos > 0
        sPartName = Right(sPartName, Len(sPartName) - iPos)
        iPos = InStr(1, sPartName, &quot;\&quot;)
    Loop
    On Error Resume Next
    Set Model = swApp.ActivateDoc(sPartName)
    If Err.Number <> 0 Then     'file is not currently opened
        Err.Clear
        bClose = True
    Else
        bClose = False
    End If
    Set Model = swApp.ActivateDoc2(sModelName, True, swError)
    swApp.SendMsgToUser &quot;Get the Custom Properties&quot;
    Model.Save2 True
    If bClose = True Then   'only close if we had to open it
        swApp.CloseDoc sModelName
    End If
    Set Dwg = swApp.ActivateDoc(sDwgName)
    'Rebuild the drawing
    swApp.SendMsgToUser &quot;Write the Custom Properties to the Drawing&quot;
    Dwg.EditRebuild
    'Clean Up
    Set Model = Nothing
    Set View = Nothing
    Set Dwg = Nothing
    Set swApp = Nothing
End Sub