Auto create folder script

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.

Parents

Kp61dude! over 4 years ago

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.

Reply

Kp61dude! over 4 years ago

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

Children

No Data