AnsweredAssumed Answered

Pack And Go Macro Returns Lowercase Letters

Question asked by Ryan Gaudreau on Nov 15, 2019
Latest reply on Dec 12, 2019 by Ryan Gaudreau

I have the code below, from Keith Rice, with I have modified a little bit to save the pack and go items into (current folder \ history folder \ filename folder). The only problem with this is it returns lowercase letters for all the files.  Is this something intrinsic with this method, or can it be made to output all capital letters?  I've seen the same question regarding the pack and go API, but not with with exact method.  Any help is greatly appreciated.  



Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Dim strOutputFolder As String

'set output to current folder / history / filename
strOutputFolder = swApp.GetCurrentWorkingDirectory & "HISTORY" & "\" & UCase(swModel.GetTitle)

'confirm current path
'swApp.SendMsgToUser (strOutputFolder)

If SaveAsPackAndGo(swApp, swModel, strOutputFolder) = False Then Exit Sub
End Sub

Function SaveAsPackAndGo(swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, strOutputFolder As String) As Boolean

On Error GoTo ErrHandler

Dim swPackAndGo As SldWorks.PackAndGo
Dim intDocCount As Integer
Dim vPathNames As Variant
Dim strSetPathNames() As String
Dim i As Integer
Dim vStatus As Variant
Dim strRetVal As String

Set swPackAndGo = swModel.Extension.GetPackAndGo
swPackAndGo.SetSaveToName True, strOutputFolder

vStatus = swModel.Extension.SavePackAndGo(swPackAndGo)

'Determine whether pack and go was successful
For i = 0 To UBound(vStatus)
Select Case vStatus(i)
Case 0
strRetVal = "Pack and go succeeded"
Case 1
strRetVal = "User input not correct"
Case 2
strRetVal = "File already exists"
Case 3
strRetVal = "File to save is empty"
Case 4
strRetVal = "Save error"
End Select

If vStatus(i) <> 0 Then
swApp.SendMsgToUser "Pack and go fail reason: " & vbCrLf & strRetVal
SaveAsPackAndGo = False
Exit For
SaveAsPackAndGo = True
End If

Next i

Exit Function

Debug.Print "ERROR: " & Err.Number & " " & Err.Description
swApp.SendMsgToUser "Unhandled error occurred while saving pack and go."
SaveAsPackAndGo = False
End Function