Boucle sur nom de classeur

[seb.m]

Bonjour,

J'ai beaucoup de mal avec les macros mais surtout les boucles est il me faudrait de l'aide .

J'ai creer un macro simple pour recuperer des données de different tableau et les integrer a ma base de donnée.

Dans la colonne A a partir de A3 j'ai le nom du fichier d'ou a ete extrait la ligne

Je souhaiterais creer une boucle qui recense le nom des fichier de la colonne A et la compare avec le nom des fichiers de mon serveur pour qu'il ne traite que les fichiers qui ne l'ont pas été

Je n'ai rien commencer en boucle je ne sais pas par ou commencer

Ci joint le fichier pour voir comment j'ai creer mes macros si besoin

 

[sousou]

Re : Boucle sur nom de classeur

Bobnjour SEB

Sans données et sans la configue difficile.
Mais tu trouveras ci-dessous un exemple pou tester l'existannce de fichier dont le nom est en colonne a
Ici, le chemin est le répertoire ou ce trouve le fichier Excel.

à toi!

Sub deb()
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("scripting.filesystemobject")
i = 0
While fich <> ""
Set fich = Sheets("BDD").Range("a3").Offset(i, 0)
If fso.fileexists(chemin & fich) Then
'action
MsgBox "yes"

End If
i = i + 1
Wend

End Sub

 

[seb.m]

Re : Boucle sur nom de classeur

Bonjour SOUSOU

Dans l'idée c'est ca car il faudrait qu'il scanne le repertoire et si le fichier du repertoire n'existe pas dans la colonne A il effectue une partie de macro

Il a fallu que j'ecrive ca pour que ca marche est-ce Normal?

Sub deb()
chemin = "\\b660917\_IPEDATA\80001077\XLS\"
Set fso = CreateObject("scripting.filesystemobject")
i = 0
Set fich = Sheets(1).Range("a3").Offset(i, 0)
While fich <> ""
Set fich = Sheets(1).Range("a3").Offset(i, 0)
If fso.fileexists(chemin & fich) Then
'action
MsgBox "yes"

End If
i = i + 1
Wend

 

[sousou]

Re : Boucle sur nom de classeur

re
Pour le chemin, oui si ce chemein désigne bien le répertoire où on trouve les fichiers.
Mais en me relisant, j'ai oublier =true
If fso.fileexists(chemin & fich)=true Then
'action
MsgBox "yes ici les actions à mener lorsque le fichier n'existe pas

 

[seb.m]

Re : Boucle sur nom de classeur

Bonjour,

Alors cette boucle fonctionne parfaitement malheureusement je souhaite faire l'inverse c'est a dire

Il faudrait qu'il compare la liste sur le serveur par rapport a la colone A et non la colonne A par rapport a la liste de classeur
Car des nouveaux classeur arrive tout les jours dans le dossier et c'est pour pouvoir les traiter. Une fois traité le nom du classeur aparait dans la colonne A

Merci a ceux qui savent moi je seche

 

[sousou]

Re : Boucle sur nom de classeur

Bonjour seb.m
Tu as peut-être résolu tes difficultés, mais je reprend le fil seulement maintenant.
Voici ma proposition.
L'inverse, c'est pas tout à fait les même instructions.

Sub deb()
chemindestination = "\\b660917\_IPEDATA\80001077\XLS\"

Set listfich = Sheets("BDD").Range("a3")

fich = Dir(chemindestination & "*.xls")
While fich <> ""
If existe(fich) = False Then
MsgBox fich
Else
End If
fich = Dir
Wend

End Sub
Function existe(fich)
i = 0
While listfich.Offset(i, 0) <> ""
If listfich.Offset(i, 0) = fich Then existe = True
i = i + 1
Wend
End Function

 

[seb.m]

Re : Boucle sur nom de classeur

Bonjour,

Merci pour la réponse et non je n'avais pas résolu mon problème
J'ai pris une semaine de congés et j'ai laisser le fichier au travail
Des mon retour je teste et je reviens vous dire ce qui en ai

 

[seb.m]

Re : Boucle sur nom de classeur

Merci je suis rentrer ce matin et a part quelque bug ca fonctionne j'essaye de debugger seule et si je n'y arrive pas je reviens vers vous

 

[seb.m]

Re : Boucle sur nom de classeur

Bonjour,

Ca y est je bloque

la boucle fonctionne parfaitement sans le Call RecuperationKm

Je pense que le probleme vient de la fonction Dir qui se trouve presente dans les deux macro mais pas vers le meme repertoire

Quel solution puis je trouvée pour que ca fonctionne

Le Bug se trouve lorsque dans recuperationKm le fichier n'existe pas il la macro bloque sur la ligne

Fich = dir de la macro boucle

Lorsque la macro se deroule sans fichier manquant elle ne boucle pas la fin de la premiere boucle elle s'arrete

voila le code tel qu'il est dans ma macro
____________________________________________________________
Sub Boucle()
CheminDestination = "\\b660917\_IPEDATA\80001077\XLS\"

Set listfich = Sheets(1).Range("a4")

fich = dir(CheminDestination & "*.xls")
While fich <> ""
If existe(fich) = False Then


Call OuvertureClasseur
Call RecuperationDonnee
Call RecuperationKM


Else
End If
fich = dir
Wend
Call TrierLesDonnee
Call MiseEnPage
End Sub

__________________________________________________________
Function existe(fich)
i = 0
While listfich.Offset(i, 0) <> ""
If listfich.Offset(i, 0) = fich Then existe = True
i = i + 1
Wend
End Function
____________________________________________________________________

Sub RecuperationKM()

ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = ClasseurName
ActiveCell.Replace What:="CO04", Replacement:="DO01"
ActiveCell.Replace What:=".xls", Replacement:=".csv"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Offset(0, -1).Range("A1").Select
ClasseurKmName = ActiveCell.Value
If dir("\\b660917\_IPEDATA\80001077\CSV\" & ClasseurKmName) <> "" Then
Workbooks.OpenText Filename:="\\b660917\_IPEDATA\80001077\CSV\" & ClasseurKmName, DataType:=1, Semicolon:=True, local:=True
Set wbkKm = ActiveWorkbook
Range("ax38").Select
Selection.End(xlDown).Select
ActiveCell.Copy
Windows("Extraction Donnée STT.xls").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
wbkKm.Close (False)
Else
MsgBox "Classeur absent..."
Exit Sub
End If

End Sub




Merci a ceux qui connaisse la solution