hexagon logo
Register Sign in
  • Replies 12 replies
  • Subscribers 34 subscribers
  • Views 385 views
  • Users 0 members are here
Options
Related

Auto create folder script

rtlawlor
So at my last shop we had a .bas file that would create folders. here is what i am doing.
What it used to do would create a folder for part number(if it didnt already exist) then each sub folder.

then i could use this same code in every program since it pulls in the part number, operation, serial, from a text file and assigns them a variable.






  • then i would use the same script (.bas file) on each script and it would create the folders if they didnt already exist.
  • Here play around with this one: 
    '*******************************************
'*** Author: Kp61dude
'*** Create Date: 05-15-2019
'***
'*** Flavor: Basic
'*** CMM Output Directory Creator
'*******************************************


Option Explicit
Sub Main(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20 As String)
  Dim i, j As Integer
  Dim dirNames(2, 17) As String  
  Dim strConcat As String  
  Dim objFSO, objFile As Object

  Set objFSO = CreateObject("Scripting.FileSystemObject")

  dirNames(0,0)    = i1  'OUTPUT folder in C:\
  dirNames(1,0)    = i2  'OUTPUT folder in Q:\ or TempQ
  dirNames(2,0)    = i3  'OUTPUT folder in N:\ or TempN

  dirNames(0,1)    = i4  'Part acronim
  dirNames(0,2)    = i5  'Part
  dirNames(0,3)    = i6  'WO
  dirNames(0,4)    = i7  'OP
  dirNames(0,5)    = i8  'Empty
  dirNames(0,6)    = i9  'Empty
  dirNames(0,7)    = i10 'Empty
  dirNames(0,8)    = i11 'Empty
  dirNames(0,9)    = i12 'Empty
  dirNames(0,10)   = i13 'Empty
  dirNames(0,11)   = i14 'Empty
  dirNames(0,12)   = i15 'Empty
  dirNames(0,13)   = i16 'Empty
  dirNames(0,14)   = i17 'Empty
  dirNames(0,15)   = i18 'Empty
  dirNames(0,16)   = i19 'Empty
  dirNames(0,17)   = i20 'Empty

'GoTo myEnd

  ' Create all the main _OUTPUT folders In Each drive
  ' only If variable is Not emptpy (If empty network
  ' drive is Not up and should not attemp to create
  ' directorie or else it will throw an error).

  For i = 0 To UBound(dirNames,2)
    strConcat = dirNames(i,0)
    If strConcat <> "" And strConcat <> "Error 448" Then
      If objFSO.FolderExists(strConcat) Then
        'Nothing
      Else
        Set objFile = objFSO.CreateFolder(strConcat)
      End If
    End If
  Next i

'GoTo myEnd

' Create subfolders in _OUTPUT directories.

  i = 0
  For i = 0 To UBound(dirNames,2)
    strConcat = dirNames(i,0)
    If strConcat <> "" And strConcat <> "Error 448" Then
      For j = 1 To UBound(dirNames,1)
        If dirNames(0,j) <> "" And dirNames(0,j) <> "Error 448" Then
          strConcat = strConcat &"\"& dirNames(0,j)
          If objFSO.FolderExists(strConcat) Then
            'Nothing
          Else
            Set objFile = objFSO.CreateFolder(strConcat)
          End If
        End If        
      Next j
    End If  
  Next i

myEnd:
End Sub


    Output folders are your 'main' root folders (i1-i3) ex. "C:\Users\Public\Documents\Output", the rest (i4-i20) are sub-folders. Leave whatever you don't use blank. You'll be passing all your parameters from a script call in your part routine.
  • I've been updating the batch files we use to start pc-dmis and have discovered that the windows command shell "mkdir" (or md) has gotten really smart in windows 10.

    It'll create the entire path, or if a portion of the path exists, will add the rest. Long names and names with spaces require no special handling. It's awesome. If it doesn't work like this for you, may have to enable command extensions.

    So this could be handled by a very short batch file with the path passed to it

    Not sure when this change came about. our batch files were written in XP and haven't been changed much.
  • in reply to DJAMS
    Very good input, thanks for sharing that K.I.S.S - Keep It Simple Stupid
  • in reply to DJAMS
    I think it has been like that for a long time - I remember recommending the 'mkdir' approach, as it is much easier than a Basic script, and will not suddenly error out just because a new version of PC-DMIS has been installed (there were a number of versions that had real problems with basic scripts in the first few 64-bit versions of PC-DMIS...).
  • This is the script I use.

    Sub Main()

    Dim objFSO, objShell
    Dim PCDApp, PCDPartProgram, PCDCommands, PCDCommand, retval
    Dim objFile, objFolder As Object

    Set PCDApp=CreateObject("PCDLRN.Application")
    Set PCDPartProgram=PCDApp.ActivePartProgram
    Set PCDCommands=PCDPartProgram.Commands

    Set Pathname=PCDPartProgram.GetVariableValue("PATH2")

    strPath=Pathname.StringValue

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    If objFSO.FolderExists(strPath) Then
    'Nothing
    Else
    Set objFile=objFSO.CreateFolder(strPath)
    End If

    End Sub




    Just change "PATH2" to whatever your naming convention is for the folder path.



    EXAMPLE OF CODE:

    C1 =COMMENT/INPUT,YES,FULL SCREEN=NO,
    PART NUMBER
    C2 =COMMENT/INPUT,YES,FULL SCREEN=NO,
    BATCH NUMBER
    C3 =COMMENT/INPUT,YES,FULL SCREEN=NO,
    LOT NUMBER
    C4 =COMMENT/INPUT,YES,FULL SCREEN=NO,
    SEQUENCE
    ASSIGN/U="_"
    ASSIGN/N=C1.INPUT+U+C2.INPUT+U+C3.INPUT
    ASSIGN/S=C1.INPUT+U+C2.INPUT+U+C3.INPUT+U+C4.INPUT
    ASSIGN/PATH="T:\Shared\Quality_Engineering\CMM\Master\H-BLD_JOSH pc811\PCDMIS_2014\PRODUCTION"+N+""+S+".PDF"
    ASSIGN/PATH2="T:\Shared\Quality_Engineering\CMM\Master\H-BLD_JOSH pc811\PCDMIS_2014\PRODUCTION"+N
    CS1 =SCRIPT/FILENAME= T:\SHARED\QUALITY_ENGINEERING\CMM\MASTER\H-BLD_JOSH PC811\PCDMIS_2014\PC-DMIS SCRIPT\CREATE_FOLDER.BAS
    FUNCTION/Main,SHOW=YES,,
    STARTSCRIPT/
    ENDSCRIPT/
    PRINT =LABEL/
    PRINT/REPORT,EXEC MODE=END,$
    TO_FILE=ON,APPEND=PATH,AUTO OPEN REPORT=OFF,$
    TO_PRINTER=OFF,COPIES=1,$
    TO_DMIS_REPORT=OFF,FILE_OPTION=INDEX,FILENAME=,$
    REPORT_THEORETICALS=NONE,REPORT_FEATURE_WITH_DIMEN SIONS=NO,$
    TO_EXCEL_OUTPUT=OFF,
    PREVIOUS_RUNS=DELETE_INSTANCES
  • This is what I use currently. Path1=Part number path Path2= Job number folder 

    Sub Main()

Dim objFSO, objShell
Dim PCDApp, PCDPartProgram, PCDCommands, PCDCommand, retval
Dim objFile, objFolder As Object

Set PCDApp=CreateObject("PCDLRN.Application")
Set PCDPartProgram=PCDApp.ActivePartProgram
Set PCDCommands=PCDPartProgram.Commands

Set Pathname1=PCDPartProgram.GetVariableValue("PATH1")

strPath1=Pathname1.StringValue

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strPath1) Then
'Nothing
Else
Set objFile=objFSO.CreateFolder(strPath1)
End If

Set Pathname2=PCDPartProgram.GetVariableValue("PATH2")

strPath2=Pathname2.StringValue

If objFSO.FolderExists(strPath2) Then
'Nothing
Else
Set objFile=objFSO.CreateFolder(strPath2)
End If

End Sub
  • I recognize the naming conventions in the script sources you guys posted, probably spawned off of one of my scripts. Smiley

    Thank you for posting your versions!
  • That was awesome!!!!! Thank yall so much!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  • cant get this script to work: Get error message "Error on line: 20 - OLE Automation method exception"
    "Error executing basic script" C:\USERS\PUBLIC\TEST\FOLDER.BAS:Main"
    Attached Files
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement