hexagon logo

Auto Archive Freebie!

Hi All,

Here's my script for archiving programs.

Copy it to notepad and save it as AUTOARCHIVE.BAS

NOTE / WARNING -- This script first saves the program with the current measurement data in it, then takes a copy of the file to archive.


'JON WOOD - 2013 - AUTOMETTECH LTD (UK) www.automettech.com

Sub main()


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

'Root save directory For archive
Dim archivePath
archivePath = "C:\CMM\Archive\AutoArchive"

'This is the Name of a PC-Dmis ASSIGNMENT - If it exist the value it holds will be used In the file Name
'of the archived program (i.e. can be a serial number, Or order number etc)

Dim myUID
myUID = "UID"

'NOTE! - File Name will be In the following format...
'SaveDirectory\Program Name\ProgramName_UniqueID_DateTime.prg

'i.e. C:\CMM Files\Part Program Run Instances Archive\123456-01\123456-01_abc123_20140824104232.prg

'Where...
'archivePath = "C:\CMM Files\Part Program Run Instances Archive"
'Part program = 123456-01.prg
'Serial Number / Unique Id = abc123
'DateTime = 24/08/2014 10:42:32


'===========End OF SETTINGS==========

'Create objects
Dim pcapp As Object
Set pcapp = createobject("pcdlrn.application")

Dim pcpart As Object
Set pcpart = pcapp.activepartprogram

'Save existing program
pcpart.save

'Get the current program path
Dim source_path
source_path = pcpart.fullname

'Get program Name (without file extension)
Dim progname
progname = left(pcpart.Name,len(pcpart.Name)-4)

'Create File System Object For file operations
Dim fso As Object
Set fso = createobject("scripting.filesystemobject")

'Check main archive directory And program specific directories exist
Dim ofolder As Object

If Not fso.folderexists(archivepath) Then
Set ofolder = fso.createfolder(archivepath)
End If

If Not fso.folderexists(archivepath & "\" & progname) Then
Set ofolder = fso.createfolder(archivepath & "\" & progname)
End If

'Get a UID If present
Dim uniqueid
uniqueid=""

Dim myvar As Object
Set myvar = pcpart.getvariablevalue(myUID)

If Not myVar is Nothing Then
uniqueid= myvar.stringvalue
'MsgBox(uniqueid)
End If

'Genrate the destination (save) path
dest_path = archivepath & "\" & progname & "\" & progname & "_" & uniqueid & "_" & format(now(),"YYYYMMDDHHNNSS") & ".prg"
'MsgBox(dest_path)


'Save the file
fso.copyfile source_path, dest_path


'Tidy up
Set fso = Nothing
Set pcpart = Nothing
Set pcapp = Nothing


End Sub

[CODE]


Usage in part program...

[CODE]


ASSIGN/UID="abc123"


CS5        =SCRIPT/FILENAME= C:\CMM FILES\SUBROUTINES\AUTOARCHIVE.BAS
            FUNCTION/Main,SHOW=YES,,
            STARTSCRIPT/
            ENDSCRIPT/

Parents


  • Do you have more than one PC-DMIS version installed?
    I think I had a problem once where a script didn't work because it looked for one of the other installed PC-DMIS versions.

    The fix was to open the version I was using once as an administrator. After it looked for this version.
    When you then again run another version you need to first run this version again as an administrator once.
Reply


  • Do you have more than one PC-DMIS version installed?
    I think I had a problem once where a script didn't work because it looked for one of the other installed PC-DMIS versions.

    The fix was to open the version I was using once as an administrator. After it looked for this version.
    When you then again run another version you need to first run this version again as an administrator once.
Children
No Data