instruction SaveAs dans macro

je désire faire tourner cette macro en boucle pour écrire sur les classeurs situés dans le dossier ciblé; mais j'ai un soucis avec l'instruction d'enregistrement SaveAs qui génère

Citation:

---

run time error 1004 method saveas of object _workbook failed

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Sub test() Dim Fso As Object, MonRepertoire As String Dim f1 As Object, f2 As Object, wb As Workbook   Set Fso = CreateObject("Scripting.FileSystemObject") MonRepertoire = "C:\...\.."   For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders For Each f2 In f1.Files Application.DisplayAlerts = False Set wb = Workbooks.Open(f2) ActiveSheet.Cells(11, 44).Value = "my bla bla" ActiveSheet.Cells(25, 39).Value = "my bla bla" wb.SaveAs Filename:=wb.Path & "\Xl4-" & wb.Name,FileFormat:=xlExcel4Workbook wb.Close False Application.DisplayAlerts = True Next f2 Next f1   End Sub

---

je vous remercie de votre aide ou autre conseils afin que je puisse enregistrer mes classeur excel avec leur nom et format d'origine ,

Bonsoir,

Je n'ai pas reproduit le problème.
Est-ce qu'il est possible que le répertoire en question contienne d'autres fichiers que des classeurs Excel 4.0 ?
Dans ce cas essayez avec ce code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

Sub test() Dim Fso As Object, MonRepertoire As String Dim f1 As Object, f2 As Object, wb As Workbook   Set Fso = CreateObject("Scripting.FileSystemObject") MonRepertoire = "<Mon répertoire contenant des .xlw>"   For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders For Each f2 In f1.Files Application.DisplayAlerts = False If Right(f2.Name, 4) = ".xlw" Then Set wb = Workbooks.Open(f2) ActiveSheet.Cells(11, 44).Value = "my bla bla" ActiveSheet.Cells(25, 39).Value = "my bla bla" wb.SaveAs Filename:=wb.Path & "\Xl4-" & wb.Name, FileFormat:=xlExcel4Workbook wb.Close False End If Application.DisplayAlerts = True Next f2 Next f1 End Sub

---

merci pour votre réponse rapide,effectivement l'erreur ne se produit plus par contre le programme n'écrit pas ou ne parcourt pas les dossiers il me semble

Est-ce qu'il est possible que le répertoire en question contienne d'autres fichiers que des classeurs Excel 4.0 ?
la réponse est oui.

merci de votre collaboration ,je reste à votre disposition pour tout renseignement

Bonjour,

La fonction test() du dernier post, parcours les dossiers de premier niveau de MonRepertoire.
La différence est qu'il n'ouvre que des classeurs ayant le format Excel 4.0 (repéré avec l'extension de fichier.xlw).
Tous les autres fichiers ne sont pas traités. On passe simplement au suivant.

S'il y a des classeurs ayant un autre format, il est possible que la conversion au format Excel 4.0 échoue. (ce qui provoque l'erreur à l'exécution.).
Essayer déjà d'enregistrer le classeur sans VBA pour voir si ça se passe bien.

la fonction test tourne comme il faut et parcourt tout les dossiers en insérant des champs sur les cellules ciblées ; le seul soucis est l'enregistrement après écriture qui déclenche l'erreur

Citation:

---

run time error 1004 method saveas of object _workbook failed

---

merci pour votre post ; je sais pas s'il faut faire une fonction dédié pour l'enregistrement ou si ça peut marcher avec d'autre option du SaveAS!!!

Re.

Si le format de fichier ne doit pas changer (xls reste xls, xlw reste xlw, csv reste csv), suffit de ne pas préciser FileFormat

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Private Sub CommandButton1_Click() Dim Fso As Object, MonRepertoire As String Dim f1 As Object, f2 As Object, wb As Workbook   Set Fso = CreateObject("Scripting.FileSystemObject") MonRepertoire = "<dossier contenant les sous dossiers>"   For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders For Each f2 In f1.Files Application.DisplayAlerts = False Set wb = Workbooks.Open(f2) ActiveSheet.Cells(11, 44).Value = "my bla bla" ActiveSheet.Cells(25, 39).Value = "my bla bla" wb.SaveAs Filename:=wb.Path & "\Xl4-" & wb.Name ', FileFormat:=xlExcel4Workbook wb.Close False Application.DisplayAlerts = True Next f2 Next f1 End Sub

---

merci , ça fonctionne bien comme il faut . je vous remercie encore une fois pour votre présence continue .