' Create folder and save with user input for PC-DMIS
'
' When called, it asks the user for a folder to save in
' and creates the folder if it doesn't exist - the full path
' needs to be entered with drive letter and all.
' User is the asked for a filename to save as.
'
' This path is then passed to PC-DMIS, which needs to have
' a variable called 'RESFOLDER'.
'
' Add a print command to your partprogram and make sure
' the script and the RESFOLDER variable is placed before
' the print command.
'
' Change the path in the print command to 'RESFOLDER'
' to save the report in your folder.
'
'CS1 =SCRIPT/FILENAME= C:\CREATEFOLDERINPUT.BAS
' FUNCTION/Main,SHOW=YES,,
' STARTSCRIPT/
' ENDSCRIPT/
' ASSIGN/RESFOLDER="c:\MYFOLDER\MYREPORT.pdf"
' PRINT/REPORT,EXEC MODE=END,$
' TO_FILE=ON,APPEND=RESFOLDER,$
' TO_PRINTER=OFF,$
' TO_DMIS_REPORT=OFF,FILE_OPTION=INDEX,FILENAME=,$
' REPORT_THEORETICALS=NONE,REPORT_FEATURE_WITH_DIMENSIONS=NO,$
' PREVIOUS_RUNS=DELETE_INSTANCES
'
' vpt.se 2010
'
Sub Main()
Dim objFSO, objFolder, objShell, strDirectory, InputFolder
strDirectory = InputBox("Enter folder to save in: ", "Create folder")
strFileName = InputBox("Enter filename to save as: ", "Enter filename")
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Note If..Exists. Then, Else ... End If construction
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
'WScript.Echo strDirectory & " already created "
Else
If strDirectory <> "" Then
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
End If
'If err.number = vbEmpty Then
' If strDirectory <> "" Then
' Set objShell = CreateObject("WScript.Shell")
' 'objShell.run ("Explorer" &" " & strDirectory & "\" )
' End If
'Else WScript.echo "VBScript Error: " & err.number
'End If
Dim PCDApp, PCDPartProgram, PCDCommands, PCDCommand, retval
Dim cnt As Integer
Dim found As Boolean
Dim varname
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
found = False
varname = "RESFOLDER"
strDirectory = strDirectory & "\" & strFileName & ".pdf"
For cnt = 1 To PCDCommands.Count
Set PCDCommand = PCDCommands.Item(cnt)
If ((PCDCommand.Type = 195) And (varname = PCDCommand.GetText(DEST_EXPR, 0))) Then
retval=PCDCommand.PutText("""" & strDirectory & """", SRC_EXPR, 0)
found = True
End If
Next
If Not found Then
Set PCDCommand = PCDCommands.Add(195, True)
PCDCommand.marked = True
PCDCommand.PutText(varname, DEST_EXPR, 0)
PCDCommand.PutText("""" & strDirectory & """", SRC_EXPR, 0)
End If
End Sub
' Create folder and save with user input for PC-DMIS
'
' When called, it asks the user for a folder to save in
' and creates the folder if it doesn't exist - the full path
' needs to be entered with drive letter and all.
' User is the asked for a filename to save as.
'
' This path is then passed to PC-DMIS, which needs to have
' a variable called 'RESFOLDER'.
'
' Add a print command to your partprogram and make sure
' the script and the RESFOLDER variable is placed before
' the print command.
'
' Change the path in the print command to 'RESFOLDER'
' to save the report in your folder.
'
'CS1 =SCRIPT/FILENAME= C:\CREATEFOLDERINPUT.BAS
' FUNCTION/Main,SHOW=YES,,
' STARTSCRIPT/
' ENDSCRIPT/
' ASSIGN/RESFOLDER="c:\MYFOLDER\MYREPORT.pdf"
' PRINT/REPORT,EXEC MODE=END,$
' TO_FILE=ON,APPEND=RESFOLDER,$
' TO_PRINTER=OFF,$
' TO_DMIS_REPORT=OFF,FILE_OPTION=INDEX,FILENAME=,$
' REPORT_THEORETICALS=NONE,REPORT_FEATURE_WITH_DIMENSIONS=NO,$
' PREVIOUS_RUNS=DELETE_INSTANCES
'
' vpt.se 2010
'
Sub Main()
Dim objFSO, objFolder, objShell, strDirectory, InputFolder
strDirectory = InputBox("Enter folder to save in: ", "Create folder")
strFileName = InputBox("Enter filename to save as: ", "Enter filename")
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Note If..Exists. Then, Else ... End If construction
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
'WScript.Echo strDirectory & " already created "
Else
If strDirectory <> "" Then
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
End If
'If err.number = vbEmpty Then
' If strDirectory <> "" Then
' Set objShell = CreateObject("WScript.Shell")
' 'objShell.run ("Explorer" &" " & strDirectory & "\" )
' End If
'Else WScript.echo "VBScript Error: " & err.number
'End If
Dim PCDApp, PCDPartProgram, PCDCommands, PCDCommand, retval
Dim cnt As Integer
Dim found As Boolean
Dim varname
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
found = False
varname = "RESFOLDER"
strDirectory = strDirectory & "\" & strFileName & ".pdf"
For cnt = 1 To PCDCommands.Count
Set PCDCommand = PCDCommands.Item(cnt)
If ((PCDCommand.Type = 195) And (varname = PCDCommand.GetText(DEST_EXPR, 0))) Then
retval=PCDCommand.PutText("""" & strDirectory & """", SRC_EXPR, 0)
found = True
End If
Next
If Not found Then
Set PCDCommand = PCDCommands.Add(195, True)
PCDCommand.marked = True
PCDCommand.PutText(varname, DEST_EXPR, 0)
PCDCommand.PutText("""" & strDirectory & """", SRC_EXPR, 0)
End If
End Sub
