Creating Subfolders

[MeTed]

Hi All,

I've "inherited" the following code that creates a folder structure under a
Job Number for our company:

Private Sub CreateTree(sJobNo As String, sClient As String, sProject As
String)

Dim sPath As String
Dim sClientPath As String

sPath = Left$(ActiveWorkbook.Path, Len(ActiveWorkbook.Path) - 16)
sClientPath = sPath & "Client_List"
sPath = sPath & "Year_" & Mid$(sJobNo, InStr(1, sJobNo, "-") - 4, 4) &
"_Jobs"

On Error Resume Next
MkDir sPath
On Error GoTo 0
sPath = sPath & "\" & sJobNo & "_Client_" & sClient
On Error Resume Next
MkDir sPath
On Error GoTo 0
SetAttr sPath, vbSystem
MakeDesktopIni sPath & "\desktop.ini", sProject

CreateSubFolders sPath, "Account_Management", "Accounting", "Design", _
"Pictures", "Project_Management"
CreateSubFolders sPath & "\Account_Management", "Contract", "Quotes",
"Forms", _
"Documents", "Timelines", "Sales", "SRFs"
CreateSubFolders sPath & "\Accounting", "Final_Job_Cost", "To_Bills"
CreateSubFolders sPath & "\Design", "Conceptual", "Development",
"Engineering", _
"Final", "Presentation"
CreateSubFolders sPath & "\Project_Management", "BOM's", "Costing",
"PO's", _
"Production_Documents", "Presentation"

CreateLink sJobNo, sClient

End Sub


It creates the following structure:

' Jobs
' +- XL (you are here)
' +-Client List
' | +-<Client>
' | +-<Job #> - <Job Name> (shortcut)
' +- Year <year> Jobs
' <Job #> - Client <Client Name>
' +- desktop.ini
' +- Account_Management
' | +- Contract
' | +- Forms
' | +- Documents
' | +- Timelines
' | +- Sales
' | +- SRFs
' +- Accounting
' | +- Final_Job_Costs
' | +- To_Bills
' +- Design
' | +- Conceptual
' | +- Development
' | +- Engineering
' | +- Final
' | +- Presentation
' +- Pictures
' +- Project_Management
' | +- BOM's
' | +- Costing
' | +- PO's
' | +- Production_Documents


Here is my dilemma, I can't seem to create a subfolder off of the second
level directory structure. I've tried ......\Design\Enigeering\DXFs (using
the above 'createsubfolders' code) but that doesn't work.

Any Clues??


TIA

 

[NickHK]

Not sure the problem as I have no idea what CreateSubFolders does.
However, there is the API call MakeSureDirectoryPathExists that you can use
:

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal
lpPath As String) As Long
'URL: http://www.allapi.net/
'create the directory "c:\this\is\a\test\directory\", if it doesn't exist
already
MakeSureDirectoryPathExists "c:\this\is\a\test\directory\"

NickHK

 

[Bob Phillips]

As you didn't supply the folder create macro, I knocked up this simple
version

Sub CreateSubFolders(Path As String, ParamArray pFolder() As Variant)
Dim i As Long
On Error Resume Next
For i = LBound(pFolder) To UBound(pFolder)
MkDir Path & "\" & pFolder(i)
Next i
On Error GoTo 0
End Sub


I was then able to create that directory using

CreateSubFolders sPath & "\Design\Engineering", "DXFs"

You have to stipulate the full parent directory as the first parameter, and
then add all child directories to be created as a simple directory name,
i.e. no path

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)