VBA rename files while controlling SOLIDWORKS Pack and Go function

Question

I've been messing around and trying to figure out the code to control the SOLIDWORKS pack and Go function from Excel VBA. I have figured out a pack and go function to a specific location, but I am having trouble with figuring how to change the filenames of the packed files. I have a "SaveName "string generated by Excel that I am intending to use as the packed file name. The code I have so far:

Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
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 namesCount As Long
Dim myPath As String
Dim statuses As Variant

Dim partDocExt As SldWorks.ModelDocExtension

Sub PackAndGo()

Set swApp = GetObject(, "SldWorks.Application")
Set swModelDoc = swApp.OpenDoc("E:\FORMAT\FormatSketch.SLDPRT", swDocPART)
Set swModelDocExt = swModelDoc.Extension

'Open Part
openFile = "E:\FORMAT\FormatSketch.SLDPRT"

'Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo

'Include any drawings
swPackAndGo.IncludeDrawings = True

'Set folder where to save the files
myPath = "E:\FORMAT\Temp\"
status = swPackAndGo.SetSaveToName(True, myPath)

'Flatten the Pack and Go folder structure; save all files to the root directory
swPackAndGo.FlattenToSingleFolder = True

'Pack and Go
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)
        
End Sub

Hoping that someone here knows the answer to this question and is willing to share the answer

Answer 1

You need to use GetDocumentSaveToNames and SetDocumentSaveToNames like this:

Option Explicit
Sub PackAndGo()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim OpenFilePath As String
Dim OpenFileName As String
Dim SavePath As String
Dim SaveName As String
Dim myFileName As String
Dim myExtension As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim status As Boolean
Dim statuses As Variant
Dim i As Long

OpenFilePath = "E:\FORMAT\FormatSketch.SLDPRT"
SavePath = "E:\FORMAT\Temp\"
SaveName = "mySaveName"

Set swApp = Application.SldWorks
Set swModel = swApp.OpenDoc(OpenFilePath, swDocPART)
'Set swModel = swApp.ActiveDoc
OpenFilePath = swModel.GetPathName
OpenFileName = Mid(OpenFilePath, InStrRev(OpenFilePath, "\") + 1, InStrRev(OpenFilePath, ".") - InStrRev(OpenFilePath, "\") - 1)

Set swModelDocExt = swModel.Extension

'Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo

'Include any drawings
swPackAndGo.IncludeDrawings = True

'Set folder where to save the files
status = swPackAndGo.SetSaveToName(True, SavePath)

'Get files path
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)
For i = 0 To UBound(pgFileNames)
    myFileName = Mid(pgFileNames(i), InStrRev(pgFileNames(i), "\") + 1, InStrRev(pgFileNames(i), ".") - InStrRev(pgFileNames(i), "\") - 1)
    myExtension = Right(pgFileNames(i), Len(pgFileNames(i)) - InStrRev(pgFileNames(i), ".") + 1)

    'Replace name
    If LCase(myFileName) = LCase(OpenFileName) Then
        pgFileNames(i) = SavePath & SaveName & myExtension
    End If
    Debug.Print "  Path is: " & pgFileNames(i)
Next

'Set files path
status = swPackAndGo.SetDocumentSaveToNames(pgFileNames)

'Flatten the Pack and Go folder structure; save all files to the root directory
swPackAndGo.FlattenToSingleFolder = True

'Pack and Go
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)
        
End Sub