Probleme Code création dossier

Version imprimable

Bonjour à tous,

J'ai un problème avec ce bout de code qui sert à sauvegarder mon fichier. Il créer cependant des dossiers si ils n'ont pas été fait. (Dossier Par année et Dossier par mois, le fichier aura le nom du jour)
Je sais ce qui bloque, c'est la ligne:

Code:

Dossier = "Documents and Settings\x_tlevent\Mes documents\Enregistrer2\" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yyyy")

et plus particulièrement ce passage (car j'ai essayé en marquant "\Test" et ça fonctionne):

Code:

" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yyyy")

Voici mon code dans sa globalité:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 Sub Sauvegarde() Dim Dossier As String, Fichier As String 'Mémorise et vérifie les noms de dossier et fichier On Error GoTo CreerDossier With ActiveSheet Dossier = "Documents and Settings\x_tlevent\Mes documents\Enregistrer2\" & Format(Date, "yyyy") & "\" & Format(Date, "mm-yyyy") Fichier = "FUF " & Format(Date, "dd-mm-yyyy") End With If Trim(Dossier) = "" Then Exit Sub End If If Trim(Fichier) = "" Then Exit Sub End If CreerDossier: If Err.Number = 1004 Then 'Création du dossier MkDir "C:\" & Dossier End If 'Sauvegarde Application.DisplayAlerts = False ThisWorkbook.SaveAs "C:\" & Dossier & "\" & Fichier & ".xls " Application.DisplayAlerts = True MsgBox ("Votre fichier a bien été enregistré") Exit Sub End Sub
Merci de votre aide,

26/06/2012, 12h02
tedo01

Bonjour,
Je pense que le problème vient du fait que le MkDir doit créer 2 répertoires, celui de l'année et le suivant.
Essaie de créer d'abord celui de l'année, puis celui en-dessous.

Bonjour Jackborogar, le forum

Je pense que ton problème vient du fait que tu essaye de créer un dossier et un sous-dossier en même temps. Si tu crée d'abord ton dossier Année et ensuite le sous dossier Mois, cela devrait fonctionner.

voici mon code pour tester ton soucis et ça fonctionne
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub creerdossier() Dim dtdate As Date, Dossier As String Dim intYear As Integer, strMonth As String dtdate = Cells(1, 1).Value intYear = CStr(Format(dtdate, "yyyy")) strMonth = CStr(Format(dtdate, "mmmm")) Dossier = "L:\Adrien\Toto\" & intYear MkDir Dossier Dossier = "L:\Adrien\Toto\" & intYear & "\" & strMonth MkDir Dossier End Sub
Slts

Salut,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
Option Explicit
Dim Rep As Long
 
Private Function CreationDossier(sDossier) As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Sub Test()
Dim sDossier As String
    sDossier = "C:\Documents and Settings\x_tlevent\Mes documents\Enregistrer2\" & Format(Date, "yyyy") & "\" & Format(Date, "mm")
    CreationDossier sDossier
End Sub

Merci à vous tous pour vos réponses.

J'ai utilisé la méthode de kiki29, celle-ci étant propre, clair, peu de lignes et efficace.

Voici mon code pour ceux à qui sa interesserait:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Sauvegarde()
 
    On Error GoTo CreerDossier
 
    Dim sDossier As String
    sDossier = "C:\Documents and Settings\x_tlevent\Mes documents\Enregistrer2\" & Format(Date, "yyyy") & "\" & Format(Date, "mm")
 
    Fichier = "FUF " & Format(Date, "dd-mm-yyyy")
 
CreerDossier:
    If Err.Number = 1004 Then
 
        CreationDossier sDossier
 
    End If
 
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs sDossier & "\" & Fichier & ".xls "
    Application.DisplayAlerts = True
    MsgBox ("Votre fichier a bien été enregistré")
 
    Exit Sub
 
End Sub

Bonne journée,

Cdt