Discussion :

[shakapouet]

Bonjour,

J'utilise ce code pour créer un dossier , et ensuite je souhaite enregistrer mon fichier Excel dans ce nouveau dossier.
La création du dossier fonctionne très bien mais j'ai une erreur au moment de l'enregistrement. Il me dise : erreur d exécution 1004, excel n'arrive pas à accéder au fichier. Ensuite je debug je rappui sur le bouton lecture de la console VBA et le fichier s'enregistre. Pourquoi la première fois le fichier n'arrive pas à s'enregistrer.

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
Private Sub dossier_enregistrement(ledir_archive, transporteur_nom, chemin_tmp)
 
    Dim chemin As String, Commande As String
 
    timestamp = Format(Now, "dd-mm-yyyy-hhnnss")
 
    transporteur_nom = Replace(transporteur_nom, " ", "_")
 
    'Crée d'un seul coup tous les répertoires
    'et sous-répertoires s'ils sont absents et
    'ne touche à rien s'ils sont présents
    chemin = ("" & ledir_archive & transporteur_nom & "_" & timestamp & "\")
    chemin_tmp = chemin
 
    'S'assurer d'être sur le bon lecteur où les répertoires
    'doivent être créé
    ChDrive "D"
 
    Commande = Environ("comspec") & " /c mkdir " & chemin
    Shell Commande, 0
 
    timestamps = Format(Now, "dd-mm-yyyy-hhnnss")
 
    nomFichier = "" & transporteur_nom & "_" & timestamps & ".xlsm"
 
    ActiveWorkbook.SaveAs chemin_tmp & nomFichier
 
End Sub

Merci

[jackborogar]

Bonjour,

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
Private Function CreationDossier(sDossier) As Long 'Fonction pour créer Dossier de Sauvergarde
 
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
 
End Function
 
Sub UserF10() 'Affiche la fenêtre de sauvergarde
 
    If MsgBox("Etes-vous certain de vouloir sauvegarder ?", vbYesNo + vbQuestion, "Demande de confirmation") = vbYes Then
 
        Sauvegarde 'Si bouton Oui est préssé alors on appelle la fct sauvergarde
 
    End If
 
End Sub
 
Sub Sauvegarde()
 
    On Error GoTo CreerDossier 'Si il y a une erreur alors directement à la ligne CreerDossier
 
    Dim sDossier As String
 
    sDossier = "C:\Documents and Settings\TON PROFIL\Mes documents\Enregistrer\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")
    Fichier = "LE NOM DE TON FICHIER" & Format(Date, "dd-mm-yyyy")
 
CreerDossier:
 
    If Err.Number = 1004 Then 'Si dossier pas créer
 
        CreationDossier sDossier 'On le créer en appelant la fct "CreationDossier"
 
    End If
 
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs sDossier & "\" & Fichier & ".xls " 'Sauvergarde du dossier
    Application.DisplayAlerts = True
    MsgBox ("Votre fichier a bien été enregistré") 'Fenêtre d'information
 
    Exit Sub
 
End Sub

Cdt

[shakapouet]

Parfait j'ai réadapter tes fonctions à mon cas et ça fonctionne nickel.
Merci de ton aide.