Comment sauvegarder un fichier dans un dossier inexistant ?

**licpegpon** · 19/11/2018, 14h22

Bonjour,

Dans la macro suivante, en toute fin du code, je demande à l'opérateur s'il veut sauvegarder le fichier xlsm.
Le problème c'est que par défaut le dossier "C:\Backup_ndt_Test" n'existe pas. La macro me retourne donc une erreur.
Des suggestions ? Merci par avance.

Cdlt.
Jérôme

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Sub Recup_donnees_pour_TDB()
 
'Déclaration des variables
Dim nbr As Integer
Dim Derlig As Integer
Dim x As String
Dim y As Integer
Dim i As Integer
Dim Program As String
Dim PO As String
Dim PO_Date As Date
Dim Content As String
Dim Deliv_Target_Date As Date
Dim Deliv_Date_OTD1 As Date
Dim Deliv_Time_OTD1 As String
Dim Last_Reject_Date As Date
Dim Deliv_Date_OTD2 As Date
Dim Deliv_Time_OTD2 As String
Dim Quality_OQD As Integer
Dim Quality_NC_Iteration As String
Dim Global_note As Single
Dim Deliv_Note_Test As Date
Dim Deliv_Note_A As Date
Dim Good_Receipt As Date
Dim Status As String
Dim Comments As String
Dim Chemin As String
Dim Fichier As String
 
'Exécution de la macro "Recuperation_Noms_sous_dossiers"
Call Recuperation_Noms_sous_dossiers
 
'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False
 
nbr = 0
 
'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> derlig
'Recherche du nombre de références ID en colonne B --> nbr
Derlig = Application.WorksheetFunction.CountA(Range("B:B")) + 3
nbr = Range("B6:B" & Derlig).SpecialCells(xlCellTypeVisible).Count
 
'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr & " ID's references")
 
'Initialisation des compteurs (on part de la ligne 6)
i = 1
y = 6
 
'Boucle sur le nombre de références ID, nbr (remplissage du tableau)
While i <= nbr
 
'Activation du fichier "FOLLOW_UP_TEST.xlsm", on active l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
'x correspond à la valeur de la cellule B6 (première valeur de la liste)
x = Range("B" & y).Value
 
'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate
 
'Mise en mémoire des données du fichier "Entry_Form_ID.....xlsm". Celles-ci sont à rapatrier dans le fichier "FOLLOW_UP_TEST.xlsm"
Program = Range("C7").Value
PO = Range("C8").Value
PO_Date = Range("C9").Value
Content = Range("C10").Value
Deliv_Target_Date = Range("H6").Value
Deliv_Date_OTD1 = Range("H8").Value
Deliv_Time_OTD1 = Range("H9").Value
Last_Reject_Date = Range("H11").Value
Deliv_Date_OTD2 = Range("H13").Value
Deliv_Time_OTD2 = Range("H14").Value
Quality_OQD = Range("N8").Value
Quality_NC_Iteration = Range("M10").Value
Global_note = Range("M12").Value
Deliv_Note_Test = Range("F21").Value
Deliv_Note_A = Range("F22").Value
Good_Receipt = Range("E30").Value
Status = Range("E31").Value
Comments = Range("E32").Value
 
'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
'On colle les valeurs précédemment mises en mémoire dans le fichier "FOLLOW_UP_TEST.xlsm" (onglet "Feuil1")
Range("C" & y).Value = Program
Range("D" & y).Value = PO
Range("E" & y).Value = PO_Date
Range("F" & y).Value = Content
Range("G" & y).Value = Deliv_Target_Date
Range("I" & y).Value = Deliv_Date_OTD1
Range("J" & y).Value = Deliv_Time_OTD1
Range("L" & y).Value = Quality_OQD
Range("M" & y).Value = Last_Reject_Date
Range("N" & y).Value = Deliv_Date_OTD2
Range("P" & y).Value = Deliv_Time_OTD2
Range("Q" & y).Value = Quality_NC_Iteration
Range("R" & y).Value = Deliv_Note_Test
Range("S" & y).Value = Deliv_Note_A
Range("T" & y).Value = Good_Receipt
Range("U" & y).Value = Status
Range("V" & y).Value = Comments
Range("W" & y).Value = Global_note
 
y = y + 1
i = i + 1
 
'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False
 
Wend
 
'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
Range("A1").Select
 
MsgBox ("Update finished")
 
Application.EnableEvents = True
 
'Possibilité de sauvegarder le fichier "FOLLOW_UP_TEST.xlsm" sur le disque local avec intégration de la date et de l'heure dans le nom du fichier.
If MsgBox("Do you want to save the file 'FOLLOW_UP_TEST.xlsm' to your local disk ?", vbYesNo, "Confirmation Request") = vbNo Then
Exit Sub
Else
Chemin = InputBox("Select the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TEST\")
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = "FOLLOW_UP_TEST_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End If
 
End Sub

**Pierre Fauconnier** · 19/11/2018, 14h23

Salut.

En testant avant la sauvegarde que le dossier existe et le créer s'il n'existe pas...

Invité · 19/11/2018, 14h26

Bonjour

Si le répertoire n'existe pas il faut le créer, tout simplement : https://docs.microsoft.com/en-us/off...kdir-statement

Philippe

**Igloobel** · 19/11/2018, 15h11

Bonjour à tous,

Pierre et Philippe n'auriez-vous pas oublié ce que notre ami Warin à fait !!!

voici un lien "indoor" ou tout y est expiliqué :
- verifier si une unité de disque est présente ou pas et comment y remedier
- verifier si un dossier est présent ou pas et comment y remedier
- verifier si un fichier est présent ou pas et comment y remedier

bref tout y est présent et c'est pour moi une varitable mine d'informations (quasi un livre de chevet

)

https://warin.developpez.com/access/fichiers/#LI-C

la seule chose que je déplore c'est que c'est présent que pour ACCESS

si un lien existait dans les tutos Excel ce serait bien parce que cela fonctionne aussi bien avec VBA Excel et VBA Access

Bonne journée à tous

**MarcelG** · 19/11/2018, 15h20

Bonjour Igloobel,

la seule chose que je déplore c'est que c'est présent que pour ACCESS

Je ne crois pas.
Les méthodes et propriétés FSO sont valables pour Excel.
J'ai parcouru rapidement ce tutoriel (très complet) et je n'y ai pas vu de spécificités Access.

**licpegpon** · 19/11/2018, 15h21

Beaucoup d'infos à digérer (je suis débutant). Qu est ce que cela pourrait donner dans mon code ?

cdlt
Jérôme.

**Igloobel** · 19/11/2018, 15h29

Envoyé par MarcelG

Bonjour Igloobel,

Je ne crois pas.
Les méthodes et propriétés FSO sont valables pour Excel.
J'ai parcouru rapidement ce tutoriel (très complet) et je n'y ai pas vu de spécificités Access.

c'est ce que je dis pourquoi n'est-ce que dans les tutos ACCESS ?

si un lien existait dans les tutos Excel ce serait bien parce que cela fonctionne aussi bien avec VBA Excel et VBA Access

**Pierre Fauconnier** · 19/11/2018, 15h33

Sans utiliser FSO, et pour autant que le dossier parent existe (cfr ton exemple de tester un dossier à la racine de C:\)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function FolderExists(FolderName As String) As Boolean
  FolderExists = Dir(FolderName, vbDirectory) <> ""
End Function
 
Sub CreateFolder(FolderName As String)
  MkDir FolderName
End Sub
 
Sub Test2()
  Dim FolderName As String
 
  FolderName = "n:\Test VBA"
  If Not FolderExists(FolderName) Then CreateFolder FolderName
End Sub

**Pierre Fauconnier** · 19/11/2018, 15h35

Envoyé par Igloobel

c'est ce que je dis pourquoi n'est-ce que dans les tutos ACCESS ?

Parce qu'il faut du temps pour réorganiser les rubriques en fonction de ce qui est spécifique à une techno et ce qui est générique à VBA... Et du temps, nous en avons (très) peu...

**Pierre Fauconnier** · 19/11/2018, 15h47

@licpegpon

Tu aurais intérêt à scinder ton code en plusieurs morceaux, chaque "morceau" s'occupant d'une tâche bien précise. La sauvegarde du fichier n'a en fait aucun rapport avec le traitement des données en lui-même. En morcellant ton code, tu pourras tester chaque "petite" partie d'une part, et d'autre part écrire du code générique pour ce qui sera réutilisé. Le test de l'existence d'un dossier, sa création éventuelle et la sauvegarde du fichier dans ledit dossier n'ont rien à voir avec le traitement des données qui constitue le coeur de ta macro.

Pour la problématique évoquée (enregistrement dans un dossier inexistant), j'ai transféré sur le forum VBA...

**licpegpon** · 19/11/2018, 15h52

Merci pour votre aide.....Je me rends dans le forum VBA. Je croyais y être ??

Cdlt.
Jérôme.

**Pierre Fauconnier** · 19/11/2018, 15h54

Tu étais dans le forum EXCEL-VBA, mais ta problématique est VBA et ne concerne en fait pas Excel (ou alors de façon très indirecte). Ta discussion a été redirigée vers le forum général VBA, de sorte que tu n'as pas besoin de t'y rendre, ta liste de discussions suivies ou ton tableau de bord te dirigeant automatiquement vers tes discussions, quel que soit le forum où elles se trouvent...

(Ce message s'autodétruira dans 30 minutes...

)

**licpegpon** · 19/11/2018, 16h22

(Re)bonjour,

@Pierre Fauconnier

J'ai effectué les modifs suivantes et j'ai une erreur à l'instruction MkDir FolderName....

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
Function FolderExists(FolderName As String) As Boolean
  FolderExists = Dir(FolderName, vbDirectory) <> ""
End Function
 
Sub CreateFolder(FolderName As String)
  MkDir FolderName
End Sub
 
Sub Test2()
 
  Dim FolderName As String
  Dim Dossier As String
 
 Dossier = InputBox("Enter the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TEST")
  FolderName = Dossier
  MsgBox ("Foldername = " & FolderName)
  If Not FolderExists(FolderName) Then CreateFolder FolderName
End Sub

**Pierre Fauconnier** · 19/11/2018, 16h46

Le nom du dossier doit être complet (racine comprise)... C'est peut-être là que le bât blesse.

Pourquoi n'utiliserais-tu pas les fenêtres de dialogues pour choisir ton dossier de sauvegarde? Ce serait plus fiable pour la "saisie" du nom du dossier, et tu délèguerais ainsi à Windows la création du dossier si besoin.

**licpegpon** · 19/11/2018, 17h36

Re,

Je ne comprend pas. La valeur par défaut proposée dans l'inputbox est "C:\Backup_NDT_TEST\". Ce nom est complet pourtant ?

En effet :

Code :

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

Chemin = InputBox("Select the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TEST\")

Pourquoi n'utiliserais-tu pas les fenêtres de dialogues pour choisir ton dossier de sauvegarde? Ce serait plus fiable pour la "saisie" du nom du dossier, et tu déléguerais ainsi à Windows la création du dossier si besoin --> je ne comprend pas ce que vous voulez dire ? Code associé ?
Merci.

Cdlt.
Jérôme.

**licpegpon** · 20/11/2018, 15h18

Bonjour,

Pas de suggestions suite à mon précédent message ? Merci par avance.

Cdlt.
Jérôme.

**Pierre Fauconnier** · 20/11/2018, 15h26

Dans un précédent message, tu dis que tu as une erreur sur MKDIR... Quelle erreur (n°, message)? As-tu, à ce moment-là, vérifier la valeur de la chaîne qui représente le chemin à créer?

Tu montres la valeur récupérée (peut-être!) par ton inputbox? Qu'en fais-tu après? Quel le le code qui utilise cette information?

**licpegpon** · 20/11/2018, 16h40

Bonjour,

Voici deux captures d'écran.

Cdlt.
Jérôme.

**Pierre Fauconnier** · 20/11/2018, 17h01

J'aurais tendance à dire que ton dossier existe déjà. Poste le code (un simple copier coller de ton code que tu places entre les balises de code - bouton # de l'éditeur).

Lance ta proc pas à pas pour pour passer sur chaque ligne et vérifie bien les valeurs à chaque étape. Ton premier msgbox parle de TESTIA alors que dans les exemples précédents, tu parlais uniquement de TEST...

**licpegpon** · 20/11/2018, 17h14

Voici le code complet sans modif (textes effacés, ...).

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
Sub Recup_donnees_pour_TDB()
 
'Déclaration des variables
Dim nbr As Integer
Dim Derlig As Integer
Dim x As String
Dim y As Integer
Dim i As Integer
Dim Program As String
Dim PO As String
Dim PO_Date As Date
Dim Content As String
Dim Deliv_Target_Date As Date
Dim Deliv_Date_OTD1 As Date
Dim Deliv_Time_OTD1 As String
Dim Last_Reject_Date As Date
Dim Deliv_Date_OTD2 As Date
Dim Deliv_Time_OTD2 As String
Dim Quality_OQD As Integer
Dim Quality_NC_Iteration As String
Dim Global_note As Single
Dim Deliv_Note_Testia As Date
Dim Deliv_Note_AIRBUS As Date
Dim Good_Receipt As Date
Dim Status As String
Dim Comments As String
Dim Chemin As String
Dim Fichier As String
Dim Method As String
 
'Exécution de la macro "Recuperation_Noms_sous_dossiers"
Call Recuperation_Noms_sous_dossiers
 
'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False
 
nbr = 0
 
'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> derlig
'Recherche du nombre de références ID en colonne B --> nbr
Derlig = Application.WorksheetFunction.CountA(Range("B:B")) + 3
nbr = Range("B6:B" & Derlig).SpecialCells(xlCellTypeVisible).Count
 
'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr & " ID's references")
 
'Initialisation des compteurs (on part de la ligne 6)
i = 1
y = 6
 
'Boucle sur le nombre de références ID, nbr (remplissage du tableau)
While i <= nbr
 
'Activation du fichier "FOLLOW_UP_TESTIA.xlsm", on active l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate
 
'x correspond à la valeur de la cellule B6 (première valeur de la liste)
x = Range("B" & y).Value
 
'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate
 
'Mise en mémoire des données du fichier "Entry_Form_ID.....xlsm". Celles-ci sont à rapatrier dans le fichier "FOLLOW_UP_TESTIA.xlsm"
Program = Range("C7").Value
PO = Range("C8").Value
PO_Date = Range("C9").Value
Content = Range("C10").Value
Deliv_Target_Date = Range("H6").Value
Deliv_Date_OTD1 = Range("H8").Value
Deliv_Time_OTD1 = Range("H9").Value
Last_Reject_Date = Range("H11").Value
Deliv_Date_OTD2 = Range("H13").Value
Deliv_Time_OTD2 = Range("H14").Value
Quality_OQD = Range("N8").Value
Quality_NC_Iteration = Range("M10").Value
Global_note = Range("M12").Value
Deliv_Note_Testia = Range("F21").Value
Deliv_Note_AIRBUS = Range("F22").Value
Good_Receipt = Range("E30").Value
Status = Range("E31").Value
Comments = Range("E32").Value
Method = Range("C11").Value
 
'On active le fichier "FOLLOW_UP_TESTIA.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate
 
'On colle les valeurs précédemment mises en mémoire dans le fichier "FOLLOW_UP_TESTIA.xlsm" (onglet "Feuil1")
Range("C" & y).Value = Program
Range("D" & y).Value = PO
Range("E" & y).Value = PO_Date
Range("F" & y).Value = Content
Range("G" & y).Value = Deliv_Target_Date
Range("I" & y).Value = Deliv_Date_OTD1
Range("J" & y).Value = Deliv_Time_OTD1
Range("L" & y).Value = Quality_OQD
Range("M" & y).Value = Last_Reject_Date
Range("N" & y).Value = Deliv_Date_OTD2
Range("P" & y).Value = Deliv_Time_OTD2
Range("Q" & y).Value = Quality_NC_Iteration
Range("R" & y).Value = Deliv_Note_Testia
Range("S" & y).Value = Deliv_Note_AIRBUS
Range("T" & y).Value = Good_Receipt
Range("U" & y).Value = Status
Range("V" & y).Value = Comments
Range("W" & y).Value = Global_note
Range("X" & y).Value = Method
 
y = y + 1
i = i + 1
 
'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False
 
Wend
 
'On active le fichier "FOLLOW_UP_TESTIA.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate
 
Range("A1").Select
 
MsgBox ("Update finished")
 
Application.EnableEvents = True
 
'Possibilité de sauvegarder le fichier "FOLLOW_UP_TESTIA.xlsm" sur le disque local avec intégration de la date et de l'heure dans le nom du fichier.
If MsgBox("Do you want to save the file 'FOLLOW_UP_TESTIA.xlsm' to your local disk ?", vbYesNo, "Confirmation Request") = vbNo Then
Exit Sub
Else
Chemin = InputBox("Select the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TESTIA\")
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = "FOLLOW_UP_TESTIA_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End If
 
End Sub

A cela j'ai rajouté les autres macros proposées :

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
Function FolderExists(FolderName As String) As Boolean
  FolderExists = Dir(FolderName, vbDirectory) <> ""
End Function
 
Sub CreateFolder(FolderName As String)
  MkDir FolderName
End Sub
 
Sub Test2()
 
  Dim FolderName As String
  Dim Dossier As String
 
 Dossier = InputBox("Enter the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TESTIA")
  FolderName = Dossier
  MsgBox ("Foldername = " & FolderName)
  If Not FolderExists(FolderName) Then CreateFolder FolderName
End Sub

Comment sauvegarder un fichier dans un dossier inexistant ?

VBA

Discussions similaires

Partager

Partager