Visual Basic File Routines
CreateDirectory: Creating Nested Folders
     
Posted:   Saturday September 19, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB5, Windows 98
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
None.

nested.gif (10090 bytes)Applications often need to create a nested hierarchy of folders outside of Shell's move and copy routines. Typically, for the VB developer, this has entailed a convoluted combination of ChDir, MkDir and error trapping. Fortunately, as with most things, the WinAPI can come through to reduce this to a painless task using the CreateDirectory API.

One of the major benefits of this API is that it can be called to create the folders where they already exist, without incident. The return value of the call can be used to determine the success or failure of the call, but when strings are properly formatted before passing to the API, calling CreateDirectory when the specified directory exists simply returns a value indicating its existence. It is unnecessary to check for the presence of the folder before attempting to create it, as well as being unnecessary to change directories in order to create a new subdirectory. Calling CreateDirectory overtop existing folders will not harm any files inside them.

The methods here demo two ways of creating the nested folders. The first shows how when passing a fully-qualified path, for example

   buff = "c:\Demo\Sub1\Sub2\Sub3\Sub4\Sub5\Sub6\Sub7\Sub8"

The second method demonstrates using an array of folder names to create the nested levels - x(0)="c:\Demo", x(1)="sub1", x(2) = "sub2" etc.). With both methods, the principle is the same; starting with the first folder, it is created (and if it contains a drive letter, that drive is used, otherwise the application drive is assumed). Subsequent calls to CreateDirectory simply append the next subfolder name to the previously-created folder name. This is repeated until all parts of the full path (or the array) has been appended and created.

   call 1: "c:\Demo"
   call 2: "c:\Demo\Sub1"
   call 3: "c:\Demo\Sub1\Sub2"
   call 4: "c:\Demo\Sub1\Sub2\Sub3" etc ...

The code below contains two routines .. CreateNestedFoldersByPath and CreateNestedFoldersByArray. As much of the code below is made up of comments, glancing at the page may give an inaccurate perspective of just how simple (and effective!) a method this really is.

Note: This code was developed prior to VB6 and the introduction of the Split() function, which VB6 users can implement to reduce the code in the CreateNestedFoldersByPath routine significantly.

 BAS Module Code
None.

 Form Code
Add two lists (List1, List2) a Label (Label1) and two command buttons (Command1 and Command2) to a form. Add the following:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const INVALID_HANDLE_VALUE As Long= -1
Private Const MAX_PATH As Long= 260

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Private Declare Function CreateDirectory Lib "kernel32" _
   Alias "CreateDirectoryA" _
  (ByVal lpPathName As String, _
   lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
    
    
Private Sub Command1_Click()

   Dim nMade As Long
   Dim buff As String
  
  'the absolute path to create
   buff = "c:\DemoByPath\Sub1\Sub2\Sub3\Sub4\Sub5\Sub6\Sub7\Sub8"
   
  'pass ByVal in case the full path is needed
  'again. The routine splits up the string when
  'passed ByRef (the default).
   nMade = CreateNestedFoldersByPath(buff)
   
  'show success
   MsgBox buff & vbCrLf & vbCrLf & _
          nMade & " subfolders created.", _
          vbInformation, "Nested Demo"

End Sub


Private Sub Command2_Click()

   Dim nMade As Long
   Dim sfolders(0 To 8) As String
  
  'the drive, main folder and subfolders
   sfolders(0) = "c:\DemoByArray"
   sfolders(1) = "Sub1"
   sfolders(2) = "Sub2"
   sfolders(3) = "Sub3"
   sfolders(4) = "Sub4"
   sfolders(5) = "Sub5"
   sfolders(6) = "Sub6"
   sfolders(7) = "Sub7"
   sfolders(8) = "Sub8"
   
   nMade = CreateNestedFoldersByArray(sfolders)
   
  'show success
   MsgBox nMade & " subfolders created.", _
          vbInformation, "Nested Demo"

End Sub


Private Function CreateNestedFoldersByPath(ByVal completeDirectory As String) As Long

  'creates nested directories on the drive
  'included in the path by parsing the final
  'directory string into a directory array,
  'and looping through each to create the final path.
  
  'The path could be passed to this method as a
  'pre-filled array, reducing the code.
  
   Dim r As Long
   Dim SA As SECURITY_ATTRIBUTES
   Dim drivePart As String
   Dim newDirectory  As String
   Dim item As String
   Dim sfolders() As String
   Dim pos As Long
   Dim x As Long
   
  'show the path to create
   Label1.Caption = "created " & completeDirectory
   
  'must have a trailing slash for
  'the GetPart routine below
   If Right$(completeDirectory, 1) <> "\" Then
      completeDirectory = completeDirectory & "\"
   End If
  
  'if there is a drive in the string, get it
  'else, just use nothing - assumes current drive
   pos = InStr(completeDirectory, ":")

   If pos Then
      drivePart = GetPart(completeDirectory, "\")
   Else: drivePart = ""
   End If

  'now get the rest of the items that
  'make up the string
   Do Until completeDirectory = ""

    'strip off one item (i.e. "Files\")
     item = GetPart(completeDirectory, "\")

    'add it to an array for later use, and
    'if this is the first item (x=0),
    'append the drivepart
     ReDim Preserve sfolders(0 To x) As String

     If x = 0 Then item = drivePart & item
     sfolders(x) = item

    'debug only
     List1.AddItem item

    'increment the array counter
     x = x + 1

   Loop

  'Now create the directories.
  'Because the first directory is
  '0 in the array, reinitialize x to -1
   x = -1
   
   Do
   
      x = x + 1
     'just keep appending the folders in the
     'array to newDirectory.  When x=0 ,
     'newDirectory is "", so the
     'newDirectory gets assigned drive:\firstfolder.
     
     'Subsequent loops adds the next member of the
     'array to the path, forming a fully qualified
     'path to the new directory.
      newDirectory = newDirectory & sfolders(x)
      
     'the only member of the SA type needed (on
     'a win95/98 system at least)
      SA.nLength = LenB(SA)
      
      Call CreateDirectory(newDirectory, SA)
      
     'debug only
      List2.AddItem newDirectory
      
   Loop Until x = UBound(sfolders)
   
  'done. Return x, but add 1 for the 0-based array.
   CreateNestedFoldersByPath = x + 1

End Function


Private Function CreateNestedFoldersByArray(sfolders() As String) As Long

   Dim SA As SECURITY_ATTRIBUTES
   Dim newDirectory As String
   Dim x As Long
   
  'initialize x to -1
   x = -1
   
   Do
   
      x = x + 1
     
     'add a trailing slash if needed
      If Right$(sfolders(x), 1) <> "\" Then
         sfolders(x) = sfolders(x) & "\"
      End If
          
      newDirectory = newDirectory & sfolders(x)
      
      SA.nLength = LenB(SA)
      Call CreateDirectory(newDirectory, SA)
      
     'debug only
      List1.AddItem sfolders(x)
      List2.AddItem newDirectory
      
   Loop Until x = UBound(sfolders)
   
   CreateNestedFoldersByArray = x + 1

End Function


Function GetPart(startStrg As String, delimiter As String) As String

'takes a string separated by "delimiter",
'splits off 1 item, and shortens the string
'so that the next item is ready for removal.

  Dim c As Integer
  Dim item As String
  
  c = 1
  
  Do

    If Mid$(startStrg, c, 1) = delimiter Then
      
      item = Mid$(startStrg, 1, c)
      startStrg = Mid$(startStrg, c + 1, Len(startStrg))
      GetPart = item
      Exit Function
    
    End If

    c = c + 1

  Loop

End Function
 Comments
Run the app, and open Explorer to check the results. the results messagebox returns the number of folders created. Alternatively, you could assign a variable to the CreateDirectory call; a return value of 0 indicates the call did not complete (most likely because the directory already exists), and a return of 1 indicates success.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter