Create new folder and sub folders

Hi,

I have this code that will create a new folder based on the value in cell A1.

  Sub CreateFolderUsingRangeValue()
   Dim ObjA, NewFolder
  Const RootFolder As String = "j:\documents"
  NewFolder = RootFolder & "\" & Sheet1.Range("A1").Value
  Set ObjA = CreateObject("scripting.filesystemobject")
  If ObjA.FolderExists(NewFolder) = True Then
 If MsgBox("Folder Exists, do you want to erase it?", vbYesNo, "Critical Infor...") = vbNo Then

Exit Sub
Else
ObjA.deletefolder (NewFolder)
ObjA.createfolder (NewFolder)
End If
Else
ObjA.createfolder (NewFolder)
End If
End Sub

What I would also like to be able to do, is to create another folder, within the folder created in the above macro called, 'final artwork'. If anyone could give me some help with this, that would be great!