Discussion :

[jackborogar]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Voici mon code dans sa globalité:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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,

[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.

[danixdb]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[kiki29]

Salut,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jackborogar]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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