probleme de creation de reperpoire en cascade avec MkDir

[dj.run]

Bonjour à tous

me revoilou !

je rencontre un probleme pour creer des repertoire en cascade avec MkDir

voici un extrait de mon arborescence :
C:\
mes documents
excel
objectifs
gel sud
depot

2000

janvier
depot 05 01 2000
depot 10 01 2000
fevrier
ect…

2001

janvier
fevrier
ect…

2003

janvier
fevrier
ect…


le probleme est le suivant, jarrive a creer les repertoire pour les mois mais pas pour les annees .

ci joint mon code :

Sub sauv()

'enregistre le fichier et test l'existance du repertoire

'test l'existance du repertoire et le creer s'il n'existe pas
'addresse cellule v17

Dim toto As String, strapth As String
On Error Resume Next
strpath = Format(Range("v17"))
toto = GetAttr(strpath) And 1
If Err <> 0 Then
MkDir strpath
End If
'nom du fichier:
Count = Len(ActiveWorkbook.Name)
Name = Left(ActiveWorkbook.Name, Count - 10)
sauve = Format(Range("v16"), " " & "dd mm yyyy")
ActiveWorkbook.SaveAs FileName:=strpath & "\" & Name & " " & sauve, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

End Sub

v17 = C:\Mes documents\excel\OBJECTIFS\gel sud\DEPOT\2003\AVRIL

a savoir que \2003\avril change si l'on inscrit une date ex 01/01/2004
le resultat sera \2004\janvier

v16 = par exemple : 01 avril 2003


quelle solution peut on apporter pour resoudre ce probleme car là je suis la tete sous l'eau . ploouuff !!

merci d'avance piour votre aide
si besoin je peux vous joindre mon fichier.

dj.run

 

[Mytå]

Bonsoir le forum

dj.run voila une macro qui devrait faire

Sub Creer_rep_sauver()

Dim strpath As String, x As String
On Error Resume Next
strpath = "C:\Mes documents"
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If
strpath = strpath & "\excel"
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If
strpath = strpath & "\OBJECTIFS"
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If
strpath = strpath & "\gel sud"
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If
strpath = strpath & "\Depot"
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If
strpath = strpath & "\" & Range("X1").Value
x = GetAttr(strpath) And 0
If Err <> 0 Then
MkDir strpath
End If

ActiveWorkbook.SaveAs Filename:=strpath & "\depot du " & Range("v16").Value & ".xls"

End Sub