Run-Time error 1004 Document not Saved

**eric4459** · 28/04/2016, 19h35

Bonjour à tous,
Je cherche à copier une feuille Excel dans un nouveau classeur et l'enregistrer dans un dossier que je viens de créer avec la même macro.
Voici le code développé (hommage

)

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
Sub Create_Folder()
Dim File_Src As Workbook
Dim File_Dest As Workbook
Dim RFS As Worksheet
Dim Insp_Date As Range
Dim File_Path As String
Dim File_Name As String
Set RFS = ThisWorkbook.Sheets("RFS")
Set Insp_Date = RFS.Range("S26")
Const Cible = "C:\Users\Test"
Dim BV_Shell As Object
Dim BV_Folder As Object, BV_FolderItem As Object
 
Set BV_Shell = CreateObject("Shell.Application")
Set BV_Folder = BV_Shell.Namespace(Cible)
Set BV_FolderItem = BV_Folder.Self
File_Path = ThisWorkbook.Path
File_Name = Month(Insp_Date.Value) & "_" & Year(Insp_Date.Value)
MkDir File_Path & "\" & File_Name
 
Set File_Src = ActiveWorkbook
 
  RFS.Copy
  Set File_Dest = ActiveWorkbook
  ActiveWorkbook.SaveAs Filename:=File_Path & "\" & File_Name & "\" & "Nom_du_Fichier.xlsx"
 
 
End Sub

A la ligne 25, j'ai l'erreur 1004 "Document not Saved" qui apparaît.
quand j'écris comme ceci

Code :

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

 ActiveWorkbook.SaveAs Filename:="File_Path & " \ " & File_Name & " \ " & Nom_du_Fichier.xlsx"

j'ai Erreur 13 Type Mismatch

Quelqu'un a-t-il une idée de la c

que j'ai pu faire?

Autre demande, je souhaite dans le futur créer un ou plusieurs autres fichiers excel dans ce dossier nouvellement crée, comment vérifier si il existe, l'ouvrir et le rendre actif ?

Merci pour votre aide et vos conseils
Eric

**joe.levrai** · 28/04/2016, 23h22

Bonjour,

tu as bien contrôlé que le String représentant le chemin complet du nouveau fichier est correct

y'a un truc qui me turlupine

Code :

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

ActiveWorkbook.SaveAs Filename:=File_Path & "\" & File_Name & "\" & "Nom_du_Fichier.xlsx"

File_Path étant le Thisworkbook.Path, on y ajoutes le "\" et ensuite le nom du fichier suivi de son extension

Là j'ai comme l'impression que tu cherches à enregistrer le fichier dans un sous-dossier inexistant ?
Ou alors File_Name a un nom ambigu et représente en fait un SubFolders_Name (un nom de sous dossier) ?

**eric4459** · 29/04/2016, 11h39

Bonjour Joe, le Forum
Le fichier contenant ma macro se trouve dans un dossier, lorsque j’exécute la macro je crée un nouveau sous dossier à ce dossier.
Cette même macro effectue une copie d'une feuille de mon fichier source (celui qui contient la macro)dans un nouveau fichier, je souhaite enregistrer ce nouveau fichier dans le nouveau sous-dossier.
J'ai trouvé sur le forum plusieurs exemples de code dont je me suis inspiré mais je ne parviens pas à finaliser.
J'ai modifié le code, le voici :

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
Sub Create_Folder()
Dim File_Src As Workbook
Dim File_Dest As Workbook
Dim RFS As Worksheet
Dim Insp_Date As Range
Dim No As Range
Dim File_Path As String
Dim File_Name As String
Dim Wk_Name As String
Set RFS = ThisWorkbook.Sheets("RFS")
Set Insp_Date = RFS.Range("S26")
Set No_File = RFS.Range("R24")
Const Cible = "C:\Users\an00537\Desktop\Eric\01 - BAHR ESSALAM\BV Contract Follow-Up"
Dim BV_Shell As Object
Dim BV_Folder As Object, BV_FolderItem As Object
 
Set BV_Shell = CreateObject("Shell.Application")
Set BV_Folder = BV_Shell.Namespace(Cible)
Set BV_FolderItem = BV_Folder.Self
Wk_Name = "Request for Service Estimate" & " " & No_File.Value
File_Path = ThisWorkbook.Path
File_Name = Month(Insp_Date.Value) & "_" & Year(Insp_Date.Value)
MkDir File_Path & "\" & File_Name
 
Set File_Src = ActiveWorkbook
 
  RFS.Copy
  Set File_Dest = ActiveWorkbook
  'ActiveWorkbook.SaveAs Filename:=File_Path & " \ " & File_Name & " \ " & Wk_Name & ".xlsx"
File_Dest.SaveAs File_Path & " \ " & File_Name & " \ " & Wk_Name & ".xlsx"
 
End Sub

J'ai toujours une erreur 1004 mais avec une explication différente par rapport à hier et a chaque exécution, en prenant soin de supprimer le nouveau dossier, il y a une différence que je ne m'explique pas.
Voici une copie d'écran de deux fenêtre d'erreur, j'en ai fais d'autres et la partie entourée en jaune change tout le temps
Nom : Erreur Enregistrement Fichier.jpg
Affichages : 1486
Taille : 67,3 Ko

Nom : Erreur Enregistrement Fichier.jpg
Affichages : 1486
Taille : 67,3 Ko

Pourquoi le nom du fichier prend-t-il une valeur differente a chaque fois et pourquoi ne prend-t-il pas la valeur que je cherche à imposer "Wk_Name" ?
Merci pour vos conseil car là je suis bloqué

Eric

**mercatog** · 29/04/2016, 12h35

Tu as des espaces autour des \

Sinon, simplement

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
Sub CopyRFS()
Dim Folder_Name As String, Wk_Name As String
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("RFS")
    Folder_Name = ThisWorkbook.Path & "\" & Format(.Range("S26"), "mm_yyyy") & "\"
    If Dir(Folder_Name, vbDirectory) = "" Then MkDir Folder_Name
    Wk_Name = Folder_Name & "Request for Service Estimate " & .Range("R24") & ".xlsx"
    .Copy
End With
 
Application.DisplayAlerts = False
With ActiveWorkbook
    .SaveAs Wk_Name
    .Close
End With
Application.DisplayAlerts = True
End Sub

**eric4459** · 29/04/2016, 13h03

Merci Mercator,
Décidément l'homme ne voit que ce qu'il veut voir...

Merci également pour l'astuce qui me permet de vérifier la présence du dossier

Eric

**eric4459** · 04/05/2016, 18h58

Rebonjour,
Désolé de rouvrir ce post, j'ai suivi les recommandations précédentes mais l'erreur se reproduit bien que pas de manière systématique.
J'ai essayé les différentes méthodes proposées sur d'autres posts, quand je teste certaines fonctionnent mais quand je "migre" mon fichier dans le répertoire de destination final et retente un test cela ne fonctionne plus.
Voici les erreurs qui s'affichent de temps en temps sans que je sache pourquoi.
Nom : Erreur Enregistrement Fichier2.png
Affichages : 1825
Taille : 244,5 Ko

Nom : Erreur Enregistrement Fichier2.png
Affichages : 1825
Taille : 244,5 Ko

et voici mon code (en commentaires certaines des différentes méthodes testées) et le code créé par Mercator que j'ai également essayé dans tous les sens.

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
Sub Create_Folder()
Dim File_Src As Workbook
Dim File_Dest As Workbook
Dim RFS As Worksheet
Dim Insp_Date As Range
Dim Data_Clear As Range
Dim No As Range
Dim File_Path As String
Dim File_Name As String
Dim Wk_Name As String
Dim Folder_Name As String
Set RFS = ThisWorkbook.Sheets("RFS")
Set Insp_Date = RFS.Range("S26")
Set No_File = RFS.Range("R24")
Set Data_Clear = RFS.Range("C48")
Const Cible = "Z:\009 QUALITY\Service Ticket Folder\Request for Services Estimate"
Dim BV_Shell As Object
Dim BV_Folder As Object, BV_FolderItem As Object
 
Set BV_Shell = CreateObject("Shell.Application")
Set BV_Folder = BV_Shell.Namespace(Cible)
Set BV_FolderItem = BV_Folder.Self
File_Path = Cible
File_Name = Format(Insp_Date, "mmm_yyyy") & " " & Service_Request.ComboBox1
Folder_Name = File_Path & Application.PathSeparator & File_Name
Wk_Name = "Request for Service Estimate" & " " & No_File.Value & ".xls"
If Dir(Folder_Name, vbDirectory) = "" Then
MkDir Folder_Name
End If
 
  RFS.Copy
 
'With ActiveWorkbook
'    .SaveAs Filename:=Folder_Name & Application.PathSeparator & Wk_Name
 '   .Close
'End With
ActiveWorkbook.SaveAs Folder_Name & Application.PathSeparator & Wk_Name
 
'File_Dest.SaveAs Filename:=Wk_Name
'FileCopy Wk_Name, "Z:\009 QUALITY\Service Ticket Folder\Request for Services Estimate"
'File_Dest.SaveAs File_Path & "\" & File_Name & "\" & Wk_Name & ".xls"
 
ActiveWorkbook.Close
 
 
Range(RFS.Range("C48"), RFS.Range("C48").End(xlToRight).End(xlDown)).ClearContents
Range(Data_Clear.Offset(0, 4), Data_Clear.Offset(0, 4).End(xlToRight).End(xlDown)).ClearContents
Range(Data_Clear.Offset(0, 8), Data_Clear.Offset(0, 8).End(xlToRight).End(xlDown)).ClearContents
Range(Data_Clear.Offset(0, 13), Data_Clear.Offset(0, 13).End(xlToRight).End(xlDown)).ClearContents
Range(Data_Clear.Offset(0, 19), Data_Clear.Offset(0, 19).End(xlToRight).End(xlDown)).ClearContents
'Range(Data_Clear.Offset(0, 22), Data_Clear.Offset(0, 22).End(xlToRight).End(xlDown)).ClearContents
 
End Sub
Sub CopyRFS()
Dim Folder_Name As String, Wk_Name As String
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("RFS")
    Folder_Name = ThisWorkbook.Path & "\" & Format(.Range("S26"), "mmm_yyyy") & "\"
    If Dir(Folder_Name, vbDirectory) = "" Then MkDir Folder_Name
    Wk_Name = Folder_Name & "Request for Service Estimate " & .Range("R24") & ".xls"
    .Copy
End With
 
Application.DisplayAlerts = False
With ActiveWorkbook
    .SaveAs Filename:=Wk_Name
    .Close
End With
Application.DisplayAlerts = True
End Sub

Je ne sais plus trop quoi essayer, merci pour vos conseils.
Eric

**mercatog** · 04/05/2016, 19h18

Tu laisses des espaces avant ou après les \ ( après Follow-Up et avant 04_2016)
Regardes bien les messages que tu as montré en images

**eric4459** · 04/05/2016, 19h23

Bonsoir Mercator,
Il s'agit des anciennes copie d'écran, si tu regardes le code, j'ai soit supprimé les espaces, comme tu me l'avais recommandé, soit utilisé

Code :

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

Application.PathSeparator

afin d'éviter tout risque inutile.
Eric

**eric4459** · 04/05/2016, 19h40

Bonsoir à tous,
J'ai mis le nez sur ma con

Dans mon UserForm je saisissais le Numero de mon document comme ceci par exemple.

0019/16

et ma variable

Code :

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

No_File

prenait bien cette valeur

Lorsque j'avais le message d'erreur je voyais que le fichier était en cours d'enregistrement avec un nom incomplet, dans l'exemple donné j'avait

16.xlsx

J'ai testé

0019_16

et là miracle

plus de soucis
Lors de mes differents tests j'ai utilisé soit le signe

/

soit aucun signe, du coup je ne savais plus où j'étais

Eric