Your Products have been synced, click here to refresh
'******************************************* '*** 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
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
© 2024 Hexagon AB and/or its subsidiaries. | Privacy Policy | Cloud Services Agreement |