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

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

"MeTed" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
>
>

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)

"MeTed" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
>
>