Rechercher , créer et copier des fichiers dans des répertoires
Hello,
Comme tu m'as mis le doute j'ai vérifié ...
Pas besoin d'ajouter la dernière modif que je t'ai envoyé, le dernier fichier fonctionne parfaitement chez moi.
Si 2 fichiers ont le même nom cela fonctionne si pas la même extension ...
bonjour,
désolé de ne pas avoir donné de nouvelles j'étais pris par d'autres sujets.
je vais tester sur plusieurs fichiers Excel, et je te tiens informé
merci encore
bonjour,
c'est bien triste mais je n'arrive pas a m'en sortir , je copie des données dans le fichier afin de récupérer la macro, je mets bine les bonnes colonnes en variables
et cela ne fonctionne pas du tout. Franchement ca me dépasse le fichier que vous m'avez envoyé fonctionne parfaitement dès que je veux m'en servir a des fin utile c'est mort
A+
bonjour,
finalement c'est bon ca fonctionne encore un de nos fichiers qui avait un problème. Maintenant j'ai une question est il possible d'ouvrir une boite de dialogue
au départ pour demander les colonnes a traiter, je pense que oui, cela éviterait les erreurs , et encore...
par avance merci
cdt
phil
Hello,
Je n'ai plus suivi le fil de la discussion.
Mais pour la boite de dialogue, il faut regarder de la commande inputbox
ok je comprends le programme fonctionne bien maintenant
merci a toi
bonjour,
En juillet tu m'as crée un programme afin de créer des répertoires et de recopier des fichiers dedans, par moment il refuse obstinément de recopier
les fichiers ou s'arrête en plein milieu pour d'obscures raison. Si je te donne le fichier Excel tu pourrais regarder s'il te plait ou pas ?
Il traite ligne par ligne dans l'Excel et par moment la même référence revient , est ik possible qu'il refuse d'écraser le fichier précédemment copié ???
si c'est bien ca , il faudrait ajouter cette possibilité s'il te plait.
Par avance merci
Bonjour Philb77
Sans regarder le code
Une commande FileCopy peut être bloquée sur un fichier en lecture seule ou en archive (l'un ou l'autre je ne suis plus très sûr), d'ou l'intérêt de faire un traitement d'erreur (On error goto...).
re,
très bien sauf que je n'y connait rien , l'idée se serait que si cela bloque sur un fichier , il faudrait au moins que j'ai l'historique dans fichier texte .tmp
le mieux serait que cela ne bloque pas du tout :)
si j'envoie mon fichier quelqu'un peut m'aider ???...
Hello,
Tu peux poster un fichier oui, on va regarder.
bonjour,
je vous remercie, ci joint le fichier en question , le message d'erreur "permission refusée" arrive en plein milieu du défilement des copies de fichiers.
J'ai tous les droits .Petit rappel de ma demande ainsi qu'ne modification si possible.
J'ai des répertoires , ex : PDF , WORD , DXF , STEP , etc etc..
Dans ces répertoires sont stockes des dizaines voire de centaines de fichiers avec des noms identiques , dans le répertorie PDF existe titi.pdf , dans le répertoires WORD existe titi.word etc..
Dans le fichier Excel , la colonne de référence est la colonne "c" code article ou il y a une multitudes d'articles , dans les colonnes de "n" a "s" le choix de mes fournisseurs. La colonne "e" est également importante , (non prise en compte actuellement) , le mot "DET" affirme la présence réelle des fichiers présentes dans les répertoires. En l'occurrence tout les fichiers a traiter seront EP... (juste pour votre information)
Je rentre "O" sur la colonne du choix du fournisseur , le programme doit scruter la colonne "c" , puis aller chercher dans les répertoires PDF , WORD etC... et recopier dans de nouveaux répertoires avec les noms présents ligne "1" colonne "n" a "s" au même niveau que le fichier Excel.
Le programme fonctionnait bien jusqu'à ce que j'ai beaucoup plus de fichiers a traiter , il plante a un moment donné avec une erreur de permission alors que j'ai tous les droits sur les fichiers.
Petite précision, le même fichier doit pourvoir être re écrasé dans les nouveaux répertoires lors de la recopie.
Vous constaterez qu'un même nom de fichier apparait sur différentes ligne , peut être est-ce cela le problème ?
j'aurais également quelques demandes s'il vous plait :
Au lieu de donner un chemin pour le stockage des fichiers , je voudrais simplement qu'il traite dans le répertoires ou se situe le fichier Excel (laissez les lignes actuelles et les mettre en commentaires, et ajoutez les nouvelles variable dessous svp :))
Est il possible de faire en sorte de mettre en "vert" automatiquement dans la colonne "c" et "e" le fichier copié dès que c'est fait ???
De voir une fenêtre explicite qui nomme le fichier sur lequel il bug ?
merci d'avance , Phil
Hello,
Déjà on va corriger le problème de copie, après on verra
tu peux tester pour moi stp :
bonjour,
Trop fort ca fonctionne, c'est long mais ca fonctionne, je pense que c'est du aux nombres de cases a traiter , cool
phase 2 maintenant ?
Hello,
essaye comme ceci pour le reste:
Option Explicit
Sub Traitement_Folder()
'Const Name_Fold As String = "ST_" 'Prefixe des dossiers à créer
'Const Chemin_Racine As String = "C:\Users\boss\Documents\DEV-EXCEL\" 'Chemin du dossier principal
Dim Col_Type$, Col_Comm$, F_Col_ST$, L_Col_ST$, sCode_Art$, Col_CA$, sExtens$
Dim i&, Last_Row&, y&, x&
Dim rg_ST As Range
Dim Nb_St As Byte, Max_St As Byte, Row_En_Tete As Byte
Dim Cellule As Variant
Dim Tab_St, Tab_Fichier
Dim b_Ok As Boolean
Dim Fso As Object, f1 As Object, f2 As Object
Dim Chemin_Racine As String
Chemin_Racine = ThisWorkbook.Path & Application.PathSeparator
Col_Type = "E": Col_Comm = "K": F_Col_ST = "N": L_Col_ST = "S": Max_St = 6: Col_CA = "C" ' Colonnes nécéssaires
'Col_Type = "E" ' COLONNE TYPE
'Col_Comm = "K" ' COLONNE COMMENTAIRE
'F_Col_ST = "N" ' PREMIERE COLONNE ST_...
'L_Col_ST = "S" ' DERNIERE COLONNE ST_...
'Max_St = 6 ' NOMBRE DE COLONNE EN VERT DANS TON PDF
'Col_CA = "C" ' Colonne CODE ARTICLE
'Row_En_Tete = 1 'Ligne des en-tetes
Last_Row = Cells(Rows.Count, 3).End(xlUp).Row 'Dernière ligne du tableau
Row_En_Tete = 1 'Ligne des en-tetes
For i = 2 To Last_Row 'Boucle sur tout le tableau
If Cells(i, Col_Type) = "DET" _
And IsEmpty(Cells(i, Col_Comm)) Then ' Si la colonne type + commentaires sont vides
' recup nom code article + plage ST
sCode_Art = Cells(i, Col_CA): Set rg_ST = Range(F_Col_ST & i & ":" & L_Col_ST & i)
Nb_St = 0: ReDim Tab_St(Max_St): b_Ok = False
For Each Cellule In rg_ST 'Test le contenu des cellules de la plage ST de la ligne i
Nb_St = Nb_St + 1
If Not IsEmpty(Cellule) Then ' Si la cellule n'est pas vide, stock du nom du repertoire a créer
Tab_St(Nb_St - 1) = Cells(Row_En_Tete, Cellule.Column): b_Ok = True
End If
Next Cellule
If b_Ok = True Then ' Si on a au mini une cellule remplie
Nb_St = 0: ReDim Tab_Fichier(Nb_St): Set Fso = CreateObject("Scripting.FileSystemObject")
For Each f1 In Fso.GetFolder(Chemin_Racine).SubFolders 'Boucle sur tous les repertoire du repertoire principal
For Each f2 In f1.Files 'Boucle sur chaque fichier de ces repertoires
If Split(f2.Name, ".")(0) Like "*" & sCode_Art & "*" Then 'Test si le nom du fichier = nom code article
Tab_Fichier(Nb_St) = Chemin_Racine & f1.Name & "\" & f2.Name: Nb_St = Nb_St + 1
ReDim Preserve Tab_Fichier(Nb_St)
End If
Next f2
Next f1
y = 0
Do Until y > UBound(Tab_St) 'Boucle sur tous les dossiers à créer
If Tab_St(y) <> "" Then
x = 0
If Dir(Chemin_Racine & Tab_St(y), vbDirectory) = vbNullString Then _
MkDir Chemin_Racine & Tab_St(y) ' si le dossier n'existe pas on le crée (exemple ST5)
Do 'Boucle sur tous les fichiers precedemment trouvés avec le nom du code article
If Tab_Fichier(x) <> "" Then '
sExtens = "." & Mid(Tab_Fichier(x), InStrRev(Tab_Fichier(x), ".") + 1)
' FileCopy Tab_Fichier(x), Chemin_Racine & Tab_St(y) & "\" & sCode_Art & sExtens, True 'copie des fichiers avec le meme nom dans chaque répértoire
Fso.copyfile Tab_Fichier(x), Chemin_Racine & Tab_St(y) & "\" & sCode_Art & sExtens, True
'FileCopy Tab_Fichier(x), Chemin_Racine & Tab_St(y) & "\" & sCode_Art & x & sExtens 'Incremente avec un 0 et un 1 chaque fichier identique :)
x = x + 1
End If
Loop Until x = UBound(Tab_Fichier)
End If
y = y + 1
Loop
End If
Cells(i, Col_CA).Font.ColorIndex = 10: Cells(i, Col_Type).Font.ColorIndex = 10
End If
Next i
MsgBox "fin"
End Subbonjour,
phénoménal , ca fonctionne a la perfection je vous remercie , je vais certainement faire évoluer le fichier dans un avenir proche , mais déjà
la cela va m'être d'une très grande aide, merci.