export tabs into seperate worksheets into new directories

[supper's ready]

i have an excel file with 3 tabs named a, b, c
I want to export each tab to a seperate worksheet into a specific directory.

Sub CreateWorkbooks()
'Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False 'Don't show any screen movement
strSavePath = "C:\Export Test\" 'Change this to suit your needs
Set wbSource = ActiveWorkbook
For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name
wbDest.Close 'Remove this if you don't want each book closed after saving.
Next
Application.ScreenUpdating = True
Exit Sub
ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub

This code works but i want to add/change it so that:
The file is saved in a subdirectory which is created based off a cell value in each worksheet. Lets say its a MM-DD-YYYY value in A1 in each worksheet. I want the seperate worksheet created in YYYY\MM\tabname.xlsx
However, sometimes some part of the directory will already exist, so the code needs to account for this.
Any ideas?