I have a code that takes a specific part and is supposed to "Pack and Go" to another specific location while renaming these new created files, however if I have a design table linked to the part I am trying to "Pack and Go" the renaming of files doesn't happen. What could be the cause of this problem?
The code:
Option Explicit
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
Dim partDocExt As SldWorks.ModelDocExtension
Sub PackAndGo()
Call Calculate_TFVPM_FormatSketchFileName
OpenFilePath = "G:\Format Sketch\FormatSketch.SLDPRT"
SavePath = "G:\Format Sketch\Temp\"
SaveName = NewSaveName
On Error Resume Next
Set swApp = GetObject(, "SldWorks.Application")
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
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)
'Close initial template
swApp.CloseDoc (swModel.GetPathName)
End Sub