Run-Time error 1004 Document not Saved

Version imprimable

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:

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:

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:furieux: 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

28/04/2016, 23h22
joe.levrai

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:

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) ?

1 pièce(s) jointe(s)

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:

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
Pièce jointe 208294
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é :mur:

Eric

Tu as des espaces autour des \

Sinon, simplement

Code:

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

29/04/2016, 13h03
eric4459

Merci Mercator,
Décidément l'homme ne voit que ce qu'il veut voir...:oops:
Merci également pour l'astuce qui me permet de vérifier la présence du dossier:)
Eric

1 pièce(s) jointe(s)

Methodes SaveAs ne fonctionne pas toujours

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.
Pièce jointe 208747
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:

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

04/05/2016, 19h18
mercatog

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
04/05/2016, 19h23
eric4459

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:

Application.PathSeparator

afin d'éviter tout risque inutile.
Eric
04/05/2016, 19h40
eric4459

Bonsoir à tous,
J'ai mis le nez sur ma con:furieux::furieux: :oops:
Dans mon UserForm je saisissais le Numero de mon document comme ceci par exemple.

Citation:

0019/16

et ma variable

Code:

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

Citation:

16.xlsx

J'ai testé

Citation:

0019_16

et là miracle :oops: plus de soucis
Lors de mes differents tests j'ai utilisé soit le signe

Citation:

/

soit aucun signe, du coup je ne savais plus où j'étais:roll:
Eric
04/05/2016, 23h51
mercatog

Eh bien voilà, attention aux caractères interdits pour nommer un fichier (dont le /) qui est interprété comme séparateur de répertoire