Whipped this up, when executed the user are prompted to enter a serial that is used to save the partprogram (to a new copy). Might come in handy for those running serial checks and want to keep the results for each part in it's own partprogram...
The serial is added to the partprogram filename:
Let's say that the partprogram name is 'Heatshield_1' and when entering the serial as 'number 1' the partprogram is saved as 'Heatshield_1_number 1.prg'.
Not sure why the original code was removed from this post. Hopefully vpt.se won't mind me posting an adaptation of his original code and code from Craiger_NY. There is definitly more that could be added to this, like the "Check if file exists", but it gets the job done as I need right now. Hopefully it will be helpful to someone.
The original code were removed as a protest when the administrators went bananas Libya/Egypt/Syria-style on the users in the forum, banning them for different reasons (reasons which some were untrue).
Anyhow, feel free to modify the source in any way you want. But like others have done, please post your adaptation/modification of it so others can learn from it.
Here is the source with "fileexists" check:
' Displays an inputbox telling the user To enter a serialnumber
' Or other information that will be concatenated To the partprogram
' Name (partname) And saved In the current partprogram folder.
' If the file already exist, the user will be prompted and told
' to enter a new serial.
'
' vpt.se 2011
Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, fso
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set fso = CreateObject("Scripting.FileSystemObject")
ser$ = InputBox$("Enter serial number:", "Serial", "", 200, 175)
If ser$ <> "" Then
newname = PCDPartProgram.Path & PCDPartProgram.PartName & "_" & ser$ & ".PRG"
If Not fso.FileExists(newname) Then
retval = PCDPartProgram.SaveAs(newname)
Else
MsgBox "File exists - enter a new name!"
Main
End If
End If
' Cleanup
Set fso = Nothing
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
End Sub
Not sure why the original code was removed from this post. Hopefully vpt.se won't mind me posting an adaptation of his original code and code from Craiger_NY. There is definitly more that could be added to this, like the "Check if file exists", but it gets the job done as I need right now. Hopefully it will be helpful to someone.
The original code were removed as a protest when the administrators went bananas Libya/Egypt/Syria-style on the users in the forum, banning them for different reasons (reasons which some were untrue).
Anyhow, feel free to modify the source in any way you want. But like others have done, please post your adaptation/modification of it so others can learn from it.
Here is the source with "fileexists" check:
' Displays an inputbox telling the user To enter a serialnumber
' Or other information that will be concatenated To the partprogram
' Name (partname) And saved In the current partprogram folder.
' If the file already exist, the user will be prompted and told
' to enter a new serial.
'
' vpt.se 2011
Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, fso
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set fso = CreateObject("Scripting.FileSystemObject")
ser$ = InputBox$("Enter serial number:", "Serial", "", 200, 175)
If ser$ <> "" Then
newname = PCDPartProgram.Path & PCDPartProgram.PartName & "_" & ser$ & ".PRG"
If Not fso.FileExists(newname) Then
retval = PCDPartProgram.SaveAs(newname)
Else
MsgBox "File exists - enter a new name!"
Main
End If
End If
' Cleanup
Set fso = Nothing
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
End Sub
