' **********************************************************************************************************************************************************
' Based On the "AUTOARCHIVE.BAS" script from NinjaBadger (JON WOOD) And Aaron Baldauf
' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/390021-auto-archive-freebie
' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/498792-help-With-2-scripts/page2
' **********************************************************************************************************************************************************

Sub main()

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

Dim pcdpartprogram As Object
Set pcdpartprogram = pcdapp.activepartprogram

Dim fso As Object
Set fso = createobject("scripting.filesystemobject")

Dim CAD As Object
Set CAD = pcdpartprogram.CadModel

'Save existing program
pcdpartprogram.save

'Get the current program path
Dim source_path_prg
source_path_prg = pcdpartprogram.fullname
'MsgBox(source_path_prg)

'Gets the full Name of the original CAD (With path & file extension)
Dim source_path_cad
source_path_cad =  Left(source_path_prg,Len(source_path_prg)-4) & ".CAD"
'MsgBox(source_path_cad)

'Defines the root folder For the archive path
strpath = "S:\FileShare\CMM\Buffer"
'MsgBox(strpath)

'Gets the PC-DMIS variables For the archive path And file Name
Dim Customer As Object
Set Customer = pcdpartprogram.getvariablevalue("CUST")
strCustomer = Customer.stringvalue
'MsgBox(strCustomer)

Dim Item As Object
Set Item = pcdpartprogram.getvariablevalue("ITEM_NUM")
strItem = Item.stringvalue
'MsgBox(strItem)

Dim Serial As Object
Set Serial = pcdpartprogram.getvariablevalue("SER_NUM")
strSerial = Serial.stringvalue
'MsgBox(strSerial)

Dim Job As Object
Set Job = pcdpartprogram.getvariablevalue("JOB")
strJob = Job.stringvalue
'MsgBox(strJob)

'Checks If the archive path exists And creates it If Not
Dim fsofolder As Object

If Not fso.folderexists(strpath) Then
Set fsofolder = fso.createfolder(strpath)
End If

strpath = strpath & "\" & strCustomer
'MsgBox(strpath)

If Not fso.folderexists(strpath) Then 
Set fsofolder = fso.createfolder(strpath)
End If

strpath = strpath & "\" & strItem
'MsgBox(strpath)

If Not fso.folderexists(strpath) Then 
Set fsofolder = fso.createfolder(strpath)
End If

strpath = strpath & "\" & strJob
'MsgBox(strpath)

If Not fso.folderexists(strpath) Then 
Set fsofolder = fso.createfolder(strpath)
End If


'Generates the current date & time
datetime = format(now(),"MMDDYYHHNN")
'MsgBox(datetime)

'Generates the full archive Name For the part program & CAD (With path & file extension)
dest_path_prg= strpath & "\" & strCustomer & "_" & strItem & "_" & strJob & "_" & strSerial & "_" & datetime & ".PRG"
'MsgBox(dest_path_prg)

dest_path_cad= strpath & "\" & strCustomer & "_" & strItem & "_" & strJob & "_" & strSerial & "_" & datetime & ".CAD"
'MsgBox(dest_path_cad)

'Copies the original part program & CAD To the archive
fso.copyfile source_path_prg, dest_path_prg

If Not Dir(source_path_cad) = "" Then 
fso.copyfile source_path_cad, dest_path_cad
End If 


'Tidies up
Set fso = Nothing
Set pcdpartprogram = Nothing
Set pcdapp = Nothing


End Sub