Discussion :

[Passepartout007]

Bonjour,

A la fermeture d'un fichier Excel j'exporte ce fichier en copie me permettant da garder une traçabilité.

voici le code :

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
 
'****************************************************************************
'début macro de fermeture du formulaire
'****************************************************************************
Sub fermeture_formulaire()
    Application.DisplayAlerts = False 'désactive les boite de dialogue
    ThisWorkbook.Save
    Application.DisplayAlerts = True 'Remettre absolument ensuite
    Application.ScreenUpdating = False 'désactive les actualisation d'écrans
    Application.Calculation = xlCalculationManual 'désactive les calcule dans excel
 
    Nom_Dos = "\sauvBaseDonnees\" 'le nom du dossier Nom_Dos prend comme valeur "\Base_txt\"
    rep_out = ThisWorkbook.Path & Nom_Dos ' Rep_Out prend la valeur de l'emplacement du fichier excel + Nom_Dos
    fic_bd = "SauvDataBase" 'Le fichier base de données en txt prend le nom de "DataBase.txt"
 
    If Dir(rep_out) = "" Then MkDir (rep_out) 'Si Le dossier dans le qu'elle on stock le fichier txt n'existe pas alors on créé ce fichier
 
    Application.DisplayAlerts = False 'désactive les boite de dialogue
 
    ActiveWorkbook.SaveCopyAs Filename:=rep_out & Format(Now, "yyyy-mm-dd_hh-nn-ss") & "_" & fic_bd & "_" & "F" & ".xlsm" 'enregistre sous en format une copie"
 
    Application.DisplayAlerts = True 'Remettre absolument ensuite
    Application.Calculation = xlCalculationAutomatic 'réactive le calcule automatique dans excel
    Application.ScreenUpdating = True 'reactive les actualisation d'écrans
End Sub
'****************************************************************************
'Fin macro de fermeture du formulaire
'****************************************************************************

Comme vous le voyer ce code fonctionne parfaitement il créer un dossier à l'emplacement du fichier Excel et créer une copie dans ce dossier du fichier Excel un nom de fichier formalisé.

Donc si le dossier n'existe pas il le créé et copie, si le dossier existe il copie a l'intérieurs. Cependant il me renvois un message d'erreur quand mon dossier est vide.
Exemple, je sauvegarde ma base de données , cela crée le dossier, cela créé le fichier à l'intérieur du dossier. si je le refais cela ne créé pas le dossier car il est déjà présent, mais il sauvegarde bien le fichier dedant. Maintenant si je supprime le contenu du dossier mais que je laisse le dossier, la macro ne fonctionne pas. elle me renvois le message

erreur d'exécution'75':
Erreur d'accès Chemin/Fichier

Si je rajoute un document quelconques dans le dossier cela re-fonctionne. C'est donc quand le dossier est vide que la sauvegarde ne fonctionne pas. Pouvez vous m'expliquer pourquoi ? existe t'il une solution ?
cordialement,
Passepartout007

[lucasgaetan]

Bonjour Passepartout,

Sauf erreur de ma part, la fonction "Dir" renvois les fichiers à l’intérieur d'un dossier.

pour créer un dossier j'utilise:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'Nécessite d 'activer la référence "Microsoft Scripting RunTime" --> Outil/référence
Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set SourceFolder = fso.GetFolder(rep_out)
    On Error GoTo 0
    If SourceFolder Is Nothing Then
        MkDir (rep_out)
    End If

ou plus rapide mais moins propre

Code :

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

1
2
3
    On Error Resume Next
    MkDir (rep_out)
    On Error GoTo 0

[lucasgaetan]

plus d'explication ici

[Passepartout007]

Bonjour,

Merci de m'avoir appris a traiter des erreurs. J'ai opté pour ta deuxième solution. Mais je garde la première dans un coin de la tête.

Cordialement,
Passepartout007