Discussion :

[varik]

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

run time error 1004 method saveas of object _workbook failed

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
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 ,

[BlueMonkey]

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 :

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

[varik]

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

[BlueMonkey]

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.

[varik]

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

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!!!

[BlueMonkey]

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 :

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