• Home
 · 
• Files/File Controls/Input/Output
 · 
• A (slightly gratuitous) routine that will allow the user to split a supplied directory path into it

A (slightly gratuitous) routine that will allow the user to split a supplied directory path into it

A (slightly gratuitous) routine that will allow the user to split a supplied directory path into it's component parts and create each part in

Rate A (slightly gratuitous) routine that will allow the user to split a supplied directory path into it

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'--------------------------------------------------------------------------------------------------------------------------------------------
'MatBlak 2001 - feel free to use/amend or whatever...any feedback gratefully recieved :)
'--------------------------------------------------------------------------------------------------------------------------------------------
Dim part As String		'variable that holds parts of newpath for creation
Dim root As String		'initially holds drive variable for setting
Dim subpart As String	'further subdivides the part variable to allow correct formatting of creation string
Dim partlen As Integer	'holds length of part
dim n as integer,x as integer	'integer variables

'if not there already, add '\' to end of directory path string...
If Right(newpath, 1) <> "\" Then newpath = newpath & "\"
'find first '\'
n = InStr(1, newpath, "\")
'assume that 1st part of string is drive and change directory accordingly
root = Left(newpath, n)
ChDir root
'+
'inititialise variables
newpath = Mid(newpath, n, Len(newpath))
n = 1
x = 1
partlen = 1
'loop until until cumulative partlen variable = (original string length - root)
Do Until partlen = Len(newpath)
    n = (1 + partlen)
    part = Mid(newpath, n, Len(newpath))
    n = InStr(2, part, "\")
    part = Mid(part, x, n)
    Do			'inner loop to reformat if '\' not last character
        subpart = Mid(part, 1, n)
        If Right(subpart, 1) <> "\" Then n = (n - 1)	
    Loop Until Right(subpart, 1) = "\"
    part = subpart
    If Dir(part, vbDirectory) <> "" Then
        ChDir part			'if exist, set to current only
    Else				'else create, then set
        MkDir part
        ChDir part
    End If
    partlen = (partlen + Len(part))		'increment partlen
Loop
'+
create_new_subs:    			'create fixed subdirectories as req
MkDir "error\"
MkDir "activity\"
MkDir "security\"
MkDir "reports\"
ChDir "c:\"				'reset current at end of routine

exit sub

end sub