VBA Problème de boucle

[Arpette]

Bonsoir à toutes et à tous,
j'ai un problème dans cette boucle. Elle ouvre les fichiers dans un dossier "CONTROLES CLIENTSbis" il y en a 356 et les envoie vers un répertoire que j'ai nommé "NomRep".
Au premier passage elle ouvre le fichier, l'enregistre dans le bon répertoire. Le problème est qu'au second passage elle identifie bien le 2ème fichier à ouvrir mais il ne s'ouvre pas. Comprends pas..
Merci de votre aide

Sub Enregister()
Dim CheminDossier$, dossier, i As Byte, chemin$, o As Boolean, NomRep As String

CheminDossier = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\"
dossier = Array("CONTROLES CLIENTSbis") 'noms des dossiers

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 0 To UBound(dossier)
  chemin = CheminDossier & dossier(i) & "\"
  nomfich = Dir(chemin & "*.xls*") '1er fichier du dossier
  While nomfich <> ""
    o = False
    On Error Resume Next
    If IsError(Workbooks(nomfich).Name) Then 'si le fichier n'est pas déjà ouvert, on l'ouvre
       
       Application.EnableEvents = False 'on bloque les évènements de ThisWorkbook open
       
       Workbooks.Open chemin & nomfich
       Sheets("Page 1").Activate
       NomRep = Cells(35, 26).Value & "" & Cells(40, 26).Value 'Détermine le nom du dossier
       
       Application.EnableEvents = True 'on rétablit les évènements
       
       o = True
    End If
    On Error GoTo 0
    
    chemin = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\CONTROLES CLIENTS\"
           
    ActiveWorkbook.SaveAs chemin & NomRep & "\" & nomfich
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    If o Then ActiveWorkbook.Close SaveChanges:=True 'si le fichier a été ouvert on le ferme
    
    nomfich = Dir 'fichier suivant du dossier
  Wend
Next
End Sub

 

[Arpette]

Re : VBA Problème de boucle

Rebonsoir les amis, pas d'idée, car là, je sèche
Merci de votre aide
@+

 

[Compte Supprimé 979]

Re : VBA Problème de boucle

Salut Arpette,

J'ai testé cela fonctionne chez moi !?

Mets en commentaire les 2 lignes suivantes au début de ton code

' Application.ScreenUpdating = False
' Application.DisplayAlerts = False

Comme ça si tu as un message d'erreur, tu le verras

A+

 

[Arpette]

Re : VBA Problème de boucle

Salut Bruno, j'ai mis les deux lignes en commentaire, mais aucun message, mes deux variables donnent le bon chemin et le bon fichier mais il ne s'ouvre pas. Peut-être me manque-t-il une référence, j'ai les 6 premières de cochées.
Merci de ton aide
@+

 

[Compte Supprimé 979]

Re : VBA Problème de boucle

Re,

Passe en mode débogage pour savoir ce qui se passe

Mets un point d'arrêt (F9) sur la ligne : While nomfich <> ""
et lance ton code, ensuite F8 pour avancer et vérifier

PS : Il suffit de mettre ton curseur de souris sur la variable pour connaitre son contenu

A+

 

[JNP]

Re : VBA Problème de boucle

Bonjour le fil ,
Si j'ai bien compris ta macro, tu n'ouvres le fichier que pour récupérer le contenu de 2 cellules afin de renommer le fichier ...
Pourquoi dans ce cas là ne pas simplement lire les cellules sans ouvrir le fichier via 2 cellules sur ta feuille (j'ai pas trouvé comment lire depuis VBA directement, mais c'est peut-être possible ), dans le style

Range("A1").Formula = "='C:\Users\JNP\Desktop\[Téléphone.xls]JNP'!A1"

et utiliser Copy pour copier le fichier et Name pour changer son nom, le tout sans l'ouvrir
Tu gagneras en rapidité et en fiabilité ...
Bon WE

 

[Arpette]

Re : VBA Problème de boucle

Salut JNP, c'est pas tout à fait çà, je récupère le contenu des 2 cellules qui correspond au nom du dossier dans lequel sera enregistré le fichier, merci quand même. Bruno, je l'avais déjà fait. Ce que je ne comprends pas c'est qu'au premier passage il ouvre le 1er fichier trouvé, l'enregistre dans le bon dossier et ferme le classeur. Au deuxième passage quand j'arrive ici

Workbooks.Open chemin & nomfich

chemin est correcte, nomfich est bien le nom du second fichier, mais il ne l'ouvre pas.
Merci de ton aide
@+

 

[david84]

Re : VBA Problème de boucle

Bonjour,
je n'ai pas suivi le fil mais je crois que la fonction GetObject permet d’interroger , voire de modifier des valeurs dans un fichier fermé.
A+

 

[Arpette]

Re : VBA Problème de boucle

Bonjour David, je dois ouvrir le fichier pour l'enregistrer ailleur, je ne modifie rien.
Merci quand même
@+

 

[JNP]

Re : VBA Problème de boucle

Re ,

Salut JNP, c'est pas tout à fait çà, je récupère le contenu des 2 cellules qui correspond au nom du dossier dans lequel sera enregistré le fichier, merci quand même.

Cela ne change rien à mon raisonnement, ce n'est toujours que de l'assemblage en String pour les chemins, donc ma proposition devrait fonctionner

je n'ai pas suivi le fil mais je crois que la fonction GetObject permet d’interroger , voire de modifier des valeurs dans un fichier fermé.

Je viens de tester, mais GetObject ouvre une instance du fichier ...
Je vais ouvrir un autre fil (pour ne pas polluer celui-ci ), il doit bien y avoir une solution pour faire la même chose que la formule de feuille ...
Bon WE

 

[david84]

Re : VBA Problème de boucle

Re
bon, sans fichier pour tester, c'est vraiment pas facile pour moi de t'aider mais la question que je me pose est : est-ce que

chemin = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\CONTROLES CLIENTS\"

ne modifie pas

nomfich

. J'ai l'impression que tu crées un autre chemin et que la partie de ton code

chemin = CheminDossier & dossier(i) & "\"
nomfich = Dir(chemin & "*.xls*")

n'est plus d'actualité puisque "chemin" a été modifié (mais bon je pilote à vue là) .
A+

 

[Compte Supprimé 979]

Re : VBA Problème de boucle

Salut JNP

(j'ai pas trouvé comment lire depuis VBA directement, mais c'est peut-être possible

Effectivement, on peut utiliser la méthode ADO ou OLE plus simple d'utilisation

Exemple de code avec FileSystemObject

Sub Enregistrer()
  Dim Fso As Object
  Dim DossierOrigine As String, DossierSource As Object, ListeDossier()
  Dim DossierDestination As String
  Dim i As Integer, Fich As Object
  Dim Classeur As Workbook, Rng1 As String, Rng2 As String
  ' Initialisation des variables
  DossierOrigine = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\"
  DossierDestination = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\CONTROLES CLIENTS\"
  ' Nom des dossiers
  ListeDossier = Array("CONTROLES CLIENTSbis")
  ' désactiver le rafraichissement écran et les messages d'erreur
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ' Créer l'objet File System
  Set Fso = CreateObject("Scripting.FileSystemObject")
  ' Pour chaque dossier du tableau
  For i = 0 To UBound(ListeDossier)
    ' Dans le répertoire i
    Set DossierSource = Fso.GetFolder(DossierOrigine & ListeDossier(i))
    ' Pour chaque fichier du dossier
    For Each Fich In DossierSource.Files
      On Error Resume Next
      ' Méthode OLE
      Set Classeur = GetObject(Fich)
      Rng1 = Classeur.Sheets("Page 1").Range("Z35").Value  ' Cells(35,26)
      Rng2 = Classeur.Sheets("Page 1").Range("Z40").Value  ' Cells(40,26)
      Classeur.Close False
      ' Si aucune erreur
      If Err.Number = 0 Then
        Fso.CopyFile Source:=Fich, Destination:=DossierDestination & Rng1 & Rng2 & Fich.Name
      End If
      On Error GoTo 0
    Next
  Next
  ' réactiver le rafraichissement écran et les messages d'erreur
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

a+

 

[JNP]

Re : VBA Problème de boucle

Re ,

Salut JNP

Salut Bruno ...
Exactement la méthode que je préconisais, j'avais juste oublier que CopyFile pouvais en même temps modifier le nom du fichier ...
Par contre, c'est dommage d'être obliger d'ouvrir le fichier en OLE pour récupérer les données ... Mais j'ai ouvert un fil à ce propos, il y aura peut-être une solution, sinon, écrire la formule dans la feuille et la lire devrait être plus rapide que OLE, je pense ...
Bon WE et à très bientôt

 

[Arpette]

Re : VBA Problème de boucle

Mais oui David, c'est bien çà, j'ai corrigé comme ceci:

lechemin = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\CONTROLES CLIENTS\"
ActiveWorkbook.SaveAs lechemin & NomRep & "\" & nomfich

Merci pour ta lanterne et bonne journée à tous.
@+