Directory Creations

[dgkindy]

I am trying to create a project folder to store various items in.

I have created a program that will generate the directory string but I cannot get the directory to appear in the right folders.

I thought if I maintained the full path, the folders would just be created where ever the structure told it go rather then as a subdirectory of the previous location.

Project FolderLevelDirectory1Correspondence2Emails2Letters1Meeting Minutes1Schedule1Sales Order1GE Proposal1Commercial2Customer PO2SOE2Change Order History3013023031RFQ1Specifications1Drawings201-PFD202-P&ID203-General Arrangements204-Electrical205-Layout

If Not (StrPtr(ProjectName) = 0) Then 'If user cancels
ChDir "..\Desktop"
Folder = Trim(SO) & " - " & Trim(ProjectName)
ParentFolder = Folder
MkDir Folder
Folder = Folder & "\" & Cells(SRow, SCol)
PL = Cells(SRow, SCol - 1)
MkDir Folder
SRow = SRow + 1
Do Until Cells(SRow, SCol) = ""
If Cells(SRow, SCol - 1) > Cells(SRow - 1, SCol - 1) Then
Folder = Folder & "\" & Cells(SRow, SCol)
ElseIf Cells(SRow, SCol - 1) = Cells(SRow - 1, SCol - 1) Then
Pos = Len(Cells(SRow - 1, SCol))
Length = Len(Folder)
Folder = Mid(Folder, 1, Length - Pos)
Folder = Folder & Cells(SRow, SCol)
Else
x = PL - Cells(SRow, SCol - 1)
Pos = Len(Folder)
Do Until x = 0
If Mid(Folder, Pos, 1) = "\" Then x = x - 1
Pos = Pos - 1
Loop
Folder = Mid(Folder, 1, Pos + 1)
Folder = Folder & Cells(SRow, SCol)
End If
MkDir Folder
PL = Cells(SRow, SCol - 1)
SRow = SRow + 1
Loop
'ActiveWorkbook.SaveAs FileName:=Trim(SO) & " - " & ProjectName, FileFormat:=xlNormal
Else
ProjectName = "TBA"
End If
End Function

 

[CyberLynx]

By creating or rather nesting individual folders one by one on the fly, so to speak , requires you to set focus to each new folder using the ChDir function before the next sub-folder is created. By the time the nest is finished, disk focus will be in the last folder created.

The better approach in my opinion is to place the entire Folder nest into a String variable first then using Windows API, create then entire nest in one fallow swoop. If you like, each element (folder) of the nest can be placed into a String Variable Array so that files can be quickly dumped into each desired folder.

Here is code to created a new nested path. Just copy and paste the following code into a new Database Code Module:

Option Explicit

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


Public 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
   
  '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
    '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)
   Loop Until x = UBound(sfolders)
   
  'done. Return x, but add 1 for the 0-based array.
   CreateNestedFoldersByPath = 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

As a sample of how to use the provided CreateNestedFoldersByPath function, try this:

Call CreateNestedFoldersByPath("C:\RootFolder\Folder1\Folder2\Folder3\Folder5")

.