excelvbarenamesolidworks

VBA rename files while controlling SOLIDWORKS Pack and Go function


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


Solution

  • 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