Windows Folder Creation From Excel & How to Check A Folder Has Not Been Created

[nathandavies]

Hi All,
The below code creates a folder when a cell is double clicked. I have an issue which i cannot get my head around and wondered if anyone could help me alter the code.

At the minute the code will create a project root folder and sub job folder within the root folder, the issue i'm having is there will be multiple sub job folders within the root job folder. at the minute the code looks to see if the root folder has been created and if it has it ends the sub and pops up a msgbox, i'm wanting to change it so if the root folder has been created it then looks to see if the sub folder has been created if it has not been created then it will create it. if i has been created it will pop up a message box and end the sub.

I hope this makes sense to everyone if you require any further information please let me know.




'IF A PROJECT FILE DOES NOT EXIST THEN CREATE ONE
If Dir(ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName, vbDirectory) = "" Then
'IF JOB FILE DOES EXIST THEN SHOW A MESSAGE BOX AND SUB
Else
MsgBox "A project file already exists for " & JobNumber & ". This file has not been resaved."

'CREATE THE ROOT JOB FOLDER
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName
'CREATE THE SUB JOB FOLDER
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob
'CREATE THE SUB FOLDERS
'YOU CAN EDIT THE LIST OF FOLDERS THAT THIS MACRO CREATES HOWEVER MAKE SURE THE 'SAVE AS' FUNCTION BELOW MATCHES ANY ADJUSTMENTS YOU MAKE
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\CALCULATIONS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\COMMISSIONING"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\CORRESPONDANCE"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\DATASHEETS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\DRAWINGS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\DRAWINGS\CURRENT DRAWINGS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\DRAWINGS\OLD REVISIONS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\O&M"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\PICTURES"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\PICTURES\BEFORE"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\PICTURES\AFTER\"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\PURCHASE ORDERS"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\SITE NOTES"
MkDir ProjectRootFolder & "\" & CCompanyName & "\" & JobNumber & " - " & CSiteName & "\" & JobNumber & "-" & SubJob & "\QA"

[Bob Phillips]

Just plough and make them


On Error Resume Next
CompanyRootFolder = ProjectRootFolder & "\" & CCompanyName
MkDir CompanyRootFolder
SiteRootFolder = CompanyRootFolder & "\" & JobNumber & " - " & CSiteName
MkDir SiteRootFolder
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\CALCULATIONS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\COMMISSIONING"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\CORRESPONDANCE"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\DATASHEETS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\DRAWINGS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\DRAWINGS\CURRENT DRAWINGS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\DRAWINGS\OLD REVISIONS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\O&M"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\PICTURES"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\PICTURES\BEFORE"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\PICTURES\AFTER\"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\PURCHASE ORDERS"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\SITE NOTES"
MkDir SiteRootFolder & "\" & JobNumber & "-" & SubJob & "\QA"
On Error GoTo 0

[nathandavies]

Thanks XLD, worked first time!!