help, auto save .prg after run, in a specific location variable.

'TOTALLY FREE OPEN SOURCE CODE NO TRADEMARK OR COPYRIGHT WHATSOEVER
'NO WARRANTY OR GUARANTEE IMPLIED OR SPECIFIED
'WORKS WITH WITH PC-DMIS SOFTWARE

' Displays an inputbox telling the user To enter a serialnumber
' Or other information that will be concatenated To the partprogram
' Part Name from program header 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

'1) Requires variable assignment for SERNO to be in PC-DMIS program

'2) Insert at beginning of program.

'3) Additionally, use companion "Auto Save" script at end of program.

'4) For PCDMIS v2011 MR1 and up, Registy Setting "DocumentRecovery" needs to be set to False

'--------------------------------------------------------------------------

Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Dim Cmds As Object
Dim Cmd As Object
Set Cmds = PCDPartProgram.Commands

ser$ = InputBox$("Enter serial number:", "Serial", "", 200, 175)
If ser$ <> "" Then
  newname = PCDPartProgram.Path & PCDPartProgram.PartName & "_" & ser$ & ".PRG"
  retval = PCDPartProgram.SaveAs(newname)
End If

For Each Cmd In Cmds
If Cmd.Type = ASSIGNMENT Then
   If Cmd.GetText(DEST_EXPR, 0) = "SERNO" Then
      bln = Cmd.PutText("""" + ser$+ """", SRC_EXPR, 0)
      Cmd.ReDraw
   End If
End If
Next Cmd

' Cleanup
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
End Sub

'TOTALLY FREE OPEN SOURCE CODE NO TRADEMARK OR COPYRIGHT WHATSOEVER
'NO WARRANTY OR GUARANTEE IMPLIED OR SPECIFIED
'WORKS WITH WITH PC-DMIS SOFTWARE

'     1) Insert at end of program.

'     2) Additionally, use companion "Auto Save With Serial Number" script at beginning of program.


Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram 

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram

  retval = PCDPartProgram.Save


' Cleanup
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
End Sub