I am trying to create nested directories based on a list that is in excel. I have attached the list as well. The number represents the nested position for the directory. The code below works but it dumps folders into the wrong location. I have tried to chdir before making the directory to the parent folder but I seem to still get errors.
'ProjectFolder: Creates project folder
Function ProjectFolder()
Dim PRow, SRow, SCol As Integer
Dim ProjectName As String
Dim Folder As String
Dim Position, Length As Integer
Dim strArr() As String
SRow = 43
SCol = 5
SO = 2
ProjectName = "Test"
'ProjectName = InputBox("Enter project name.", "Project Execution Tool", "TBA")
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)
pFolder = Mid(Folder, 1, Len(Folder) - 1)
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
ChDir pFolder
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
Project Folder
Level Directory
1 Correspondence
2 Emails
2 Letters
1 Meeting Minutes
1 Schedule
1 Sales Order
1 GE Proposal
1 Commercial
2 Customer PO
2 SOE
2 Projet Variation
3 01-
3 02-
3 03-
3 04-
3 05-
3 06-
4 07-
5 08-
6 09-
7 10-
1 RFQ
1 Specifications
1 Drawings
2 01-PFD
2 02-P&ID
2 03-General Arrangements
2 04-Electrical
2 05-Layout
Bookmarks