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!!