hi,

i need to keep old file name, below code keep find reference, but give new name. How to i give new assembly name and keep old file name with same reference.

Option Explicit
Private Sub CommandButton1_Click()

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim myFileName As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgSetFileNames() As String
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim warnings As Long
Dim errors As Long
Dim i As Long
Dim j As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant

Set swApp = Application.SldWorks ' Open assembly

Set swModelDoc = swApp.OpenDoc6("D:\Old_File\997.sldasm", swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings)

Set swModelDocExt = swModelDoc.Extension ' Get Pack and Go object

Debug.Print "Pack and Go"

Set swPackAndGo = swModelDocExt.GetPackAndGo ' Get number of documents in assembly

namesCount = swPackAndGo.GetDocumentNamesCount

Debug.Print "  Number of model documents: " & namesCount ' Get whether to include any drawings and simulation results

Debug.Print "  Include drawings: " & swPackAndGo.IncludeDrawings

Debug.Print "  Include simulation results: " & swPackAndGo.IncludeSimulationResults ' Get current paths and filenames of the assembly's documents

status = swPackAndGo.GetDocumentNames(pgFileNames)

Debug.Print ""

Debug.Print "  Current path and filenames: "

If (Not (IsEmpty(pgFileNames))) Then

    For i = 0 To UBound(pgFileNames)
   
        Debug.Print "    The path and filename is: " & pgFileNames(i)
       
    Next i
   
End If ' Get current save-to paths and filenames of the assembly's documents

status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)

Debug.Print ""

Debug.Print "  Current default save-to filenames: "

If (Not (IsEmpty(pgFileNames))) Then

    For i = 0 To UBound(pgFileNames)
   
        Debug.Print "   The path and filename is: " & pgFileNames(i)
       
    Next i
   
End If ' Folder where to save the files

myPath = "D:\\Packandgo_New_File\"

' Create your own filenames for the model's documents

ReDim pgSetFileNames(namesCount - 1)

Debug.Print ""

Debug.Print "  My Pack and Go path and filenames before adding prefix and suffix: "

j = 0

For i = 0 To (namesCount - 1)

         myFileName = pgFileNames(i)
        
         ' Determine type of SolidWorks file based on file extension
             If InStr(LCase(myFileName), "sldprt") > 0 Then
            
                 myFileName = j & ".sldprt"
                
             ElseIf InStr(LCase(myFileName), "sldasm") > 0 Then
            
                 myFileName = j & ".sldasm"
                
            ElseIf InStr(LCase(myFileName), "slddrw") > 0 Then
           
                 myFileName = j & ".slddrw"
                
             Else
            
                 ' Only packing up SolidWorks files
                 Exit Sub
                
             End If
            
        pgSetFileNames(i) = myPath & myFileName
       
        Debug.Print "    My path and filename is: " & pgSetFileNames(i)
       
         j = j + 1
        
Next i

' Set document paths and names for Pack and Go
status = swPackAndGo.SetDocumentSaveToNames(pgSetFileNames) ' Add a prefix and suffix to the new Pack and Go filenames

swPackAndGo.AddPrefix = "SW"

swPackAndGo.AddSuffix = "PackAndGo"

' Verify document paths and filenames after adding prefix and suffix

ReDim pgGetFileNames(namesCount - 1)

ReDim pgDocumentStatus(namesCount - 1)

status = swPackAndGo.GetDocumentSaveToNames(pgGetFileNames, pgDocumentStatus)

Debug.Print ""

Debug.Print "  My Pack and Go path and filenames after adding prefix and suffix: "

For i = 0 To (namesCount - 1)

     Debug.Print "    My path and filename is: " & pgGetFileNames(i)
    
Next i

' Pack and Go

statuses = swModelDocExt.SavePackAndGo(swPackAndGo)

End Sub

thnks,