Creating Subfolders
 

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 structu

' 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

Creating Subfolders
 

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" wrote in message
...
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 structu

' 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

Creating Subfolders
 

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" wrote in message
...
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 structu

' 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