Excel Form Report, PDF File, Program File saving script. With file renaming

Hello all, with a great deal of help from WilliamL we've put together this script which will save 3 files; pdf, excel and program run. 

I put this together to simplify our CMM data inspection archive. It's a fun exercise and was challenging for me to understand so I thought I would share it with the community. For each file the naming convention is: archivePath\RUNS\progname_JobNumber_RunNumber.

I keep my master program within a "PART_NAME" subfolder, and a RUNS folder in the same directory holds the data for each part run. This script will search for the RUNS folder in the program's location and create it if missing, prompt the operator for job number, run number and then save the 3 files. Interesting note; the script finds the most recent excel file generated and renames it with the naming convention. I couldn't figure out an alternate approach to this due to how EXCELFORMREPORT is handled by PC-DMIS. 

We use Part name, job number and serial/run number at my shop, but you can change these based on your desired inputs. 

Sub Main()

    '========= SETTINGS =================

	'Author: Nicholas Norton (with lots of help from WilliamL on Nexus Forums)
	'This script saves the current measurement routine, an excel file of the report, And a pdf of the last executed report With the Single click of a button. 
	'For this script To operate properly, ensure the following:
	'1. A Print Command is In the program. Use Insert > Report Command > Print Command. The Print command must be unmarked (grayed out). Does Not matter If Print To PDF box is checked Or Not. May Not matter If pdf report is In program. Not sure.
	'2. An Excel Form Report command is In the program, titled "EXCEL_FORM1" otherwise script will fail. Use your preferred excel template within dialogue box. Uncheck (gray out) Excel file.
    '3. Script must be called On by "excecution command" (run from cursor to test, or run program) otherwise pdf report will not generate 

    
    ' Create objects For PC-DMIS And FileSystem operations
    Dim pcapp As Object, pcpart As Object, fso As Object
    Set pcapp = CreateObject("PCDLRN.Application")
    Set pcpart = pcapp.ActivePartProgram
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Save the existing program
    pcpart.Save

    ' Get the current program path And Name without extension
    Dim source_path As String, progname As String
    source_path = pcpart.FullName
    progname = Left(pcpart.Name, Len(pcpart.Name) - 4)

    ' Determine archive path from active program's directory path
    Dim lastSlashPos As Integer
    For i = Len(source_path) To 1 Step -1
        If Mid(source_path, i, 1) = "\" Then
            lastSlashPos = i
            Exit For
        End If
    Next
    Dim archivePath As String
    archivePath = Left(source_path, lastSlashPos - 1)

    Dim targetDirectory As String
    targetDirectory = archivePath & "\RUNS"
   MsgBox targetDirectory

    ' Check If the program folder exists; If Not, create it
    If fso.FolderExists(targetDirectory) Then
        Set objFolder = fso.GetFolder(targetDirectory)
       ' MsgBox targetDirectory & " already exists."
    Else
        If targetDirectory <> "" Then
            Set objFolder = fso.CreateFolder(targetDirectory)
            'MsgBox "Created directory: " & targetDirectory
        End If
    End If

    ' Prompt For Job Number And Run Number
    Dim JobNumber As String, RunNumber As String
    JobNumber = InputBox("Enter Job Number:", "Job Number Input")
    RunNumber = InputBox("Enter Run Number:", "Run Number Input")

    If JobNumber = "" Or RunNumber = "" Then
        MsgBox "Job Number or Run Number not provided. Exiting script."
        Exit Sub
    End If

    ' Generate destination path And save the program file
    Dim dest_path
    dest_path =  archivePath & "\RUNS" & "\" & progname & "_" & JobNumber & "_" & RunNumber & ".prg"
    fso.CopyFile source_path, dest_path

    '========= EXCEL REPORT GENERATION =================

    Dim DmisApp As Object, DmisCmd As Object, DmisCmds As Object, DmisPart As Object
    Set DmisApp = CreateObject("PCDLRN.Application")
    Set DmisPart = DmisApp.ActivePartProgram
    Set DmisCmds = DmisPart.Commands

    ' Adjust path For Excel save
    Dim DmisPath As String
    DmisPath = archivePath & "\RUNS"

    For Each DmisCmd In DmisCmds
      If DmisCmd.ID = "EXCEL_FORM1" Then
        DmisCmd.PutText DmisPath, 5002, 0 ' Set the Excel report path
        DmisCmd.Execute
      End If
    Next DmisCmd

    ' Rename the latest generated Excel file
    Dim newestExcelFile As Object, excelFile As Object, newestDate As Date
    newestDate = #1/1/1900#

    ' Loop To find the latest Excel file
    For Each excelFile In fso.GetFolder(DmisPath).Files
        If LCase(fso.GetExtensionName(excelFile.Name)) = "xlsx" Then
            If excelFile.DateCreated > newestDate Then
                Set newestExcelFile = excelFile
                newestDate = excelFile.DateCreated
            End If
        End If
    Next

    ' Rename the found Excel file
    If Not newestExcelFile Is Nothing Then
        Dim newExcelFileName As String
        newExcelFileName = progname & "_" & JobNumber & "_" & RunNumber & ".xlsx"
        newestExcelFile.Name = newExcelFileName
        'MsgBox "Excel file renamed to: " & newExcelFileName
    Else
        MsgBox "No Excel file found to rename."
    End If

    '========= PDF REPORT GENERATION =================

        Dim pdf_report_path As String
    pdf_report_path = archivePath & "\RUNS" & "\" & progname & "_" & JobNumber & "_" & RunNumber & ".pdf"
MsgBox pdf_report_path

    ' Initialize PC-DMIS And execute the Print report command
    Set DmisApp = CreateObject("PCDLRN.Application")
    Set DmisPart = DmisApp.ActivePartProgram
    Set DmisCmds = DmisPart.Commands

    ' Add a Print report command With dynamic file Name And location
    Set DmisCommand = DmisCmds.Add(PRINT_REPORT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString(2, PRINT_TO_FILE, 0)
    retval = DmisCommand.PutText(pdf_report_path, FILE_NAME, 1) ' Dynamic PDF file Name
    retval = DmisCommand.SetToggleString(2, FILE_COMMAND_TYPE, 0)
    retval = DmisCommand.SetToggleString(2, ONOFF_TYPE, 0)
    retval = DmisCommand.SetToggleString(1, PRINT_TO_PRINTER, 0)
    retval = DmisCommand.PutText("1", INDEX_END, 0)
    retval = DmisCommand.SetToggleString(1, PRINT_DELETE_RUNS, 0)
    retval = DmisCommand.SetToggleString(1, OUTPUT_DMIS_REPORT, 0)
    retval = DmisCommand.SetToggleString(1, OUTPUT_FEATURE_NOMS, 0)
    retval = DmisCommand.SetToggleString(1, OUTPUT_FEAT_W_DIMENS, 0)
    retval = DmisCommand.SetToggleString(2, MODE_TYPE, 0)
    retval = DmisCommand.SetToggleString(1, OUTPUT_TO_REPORT, 0)
    retval = DmisCommand.Execute
    retval = DmisCommand.Remove

    ' Clean up objects
    Set DmisCmd = Nothing
    Set DmisCmds = Nothing
    Set DmisPart = Nothing
    Set DmisApp = Nothing   
    Set fso = Nothing

End Sub