VBA recherche texte dans fichiers
bonjour a tous,
désolé pour mon niveau...je débute
je vous explique donc :
j'ai des dizaines de dossiers contenant des dizaines de sous dossiers contenants eux mêmes des dizaines de fichiers. (ça fait plusieurs milliers)
chacun des ces fichiers est un programme (lisible en TXT)pour une machine qui utilise des outils. chaque prg utilise environ une quarantaine d'outils
mon but, est de savoir pour chaque pgm, quels outils il utilise e; t inversement pour chaque outil, savoir dans quel pgm il est utilisé.
dans les pgm chaque numéro d'outil est précédé par le même suffixe : M106T
un ancien collègue avait réussi a faire quelque chose (VBA) mais c'est fastidieux ... pratique pour un pgm ou deux mais pas pour des milliers.
je ne peut malheureusement transmettre aucun fichier.
voila... si quelqu'un a une idée ; une solution; ou des suggestions je suis preneur
n’hésitez pas non plus si vous avez des questions, je n'ai peut être pas été très claires dans mes explications.
pour rappel j'ai pas un gros niveau.
merci d'avance.
Bonjour,
Par excel c'est possible même s'il doit y avoir d'autres solutions/logiciels.
Il est possible de balayer tous les dossiers t sous-dossiers, de lire tous les fichiers en mode texte, toutes les lignes et repérer les couples. L temps dépend aussi de la quantité de données, mais le programme peut être simple. Pour cela il faudrait quand même avoir un extrait d'un fichier texte au moins.
voici le code que j'utilise aujourd'hui.
dans l'absolu ça fonctionne mais je ne peux faire de recherche que sur 10 fichiers à la fois et les manipulations sont très fastidieuses , l’idéal serait de pouvoir sélectionner simplement le dossier hôte de tous ces fichiers
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim IndexFichier As Integer
Dim MonFichier As String
Dim ContenuLigne As String
Dim I As Long
Dim Deb As Long
Dim M As Long
Dim J As Long
Dim Outil As String
Dim P As Integer
Dim Out As Integer
Dim txt As String
Dim Col As Integer
Col = Cells(2, 2).Value + 2 'Attribution de la colonne à modifier
'Purge la colonne avant de remplir
Cells(3, Col).Clear
For I = 5 To 503
Cells(I, Col).Clear
Next I
MonFichier = Cells(2, 1)
Cells(3, Col).Value = MonFichier
Cells(3, Col).WrapText = True
txt = Dir(MonFichier)
If txt = "" Then 'verifier que le fichier existe
MsgBox "Fichier introuvable"
Else
IndexFichier = FreeFile()
Open MonFichier For Input As #IndexFichier 'ouvre le fichier
While Not EOF(IndexFichier) '
Line Input #IndexFichier, ContenuLigne ' lecture du fichier ligne par ligne: la variable "ContenuLigne" contient le contenu de la ligne active
P = InStr(1, ContenuLigne, ")")
If P = 0 Then 'Vertifie que l'on est pas dans un commentaire
Deb = InStr(1, ContenuLigne, "T") 'Trouve la présence d'un T et retourne sa position
M = InStr(1, ContenuLigne, "M") 'Trouve la présence d'un M et retourne sa position
J = InStr(1, ContenuLigne, "M201") 'elimine le cas d'une operation de detction bris d'outil
If Deb <> 0 And M <> 0 And J = 0 Then
If M < Deb Then
Outil = Mid(ContenuLigne, Deb + 1)
'MsgBox Outil
Out = CInt(Outil)
Cells(Out + 4, Col).Value = "X"
Else
Outil = Mid(ContenuLigne, Deb + 1, M - Deb - 1)
Out = CInt(Outil)
Cells(Out + 4, Col).Value = "X"
End If
End If
End If
Wend
Close #IndexFichier ' ferme le fichier
End If
Application.ScreenUpdating = True
End Sub
Private Sub Parcourir_Click()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
Cells(2, 1).Value = .SelectedItems(1)
End With
End Sub
Private Sub Purger_Click()
Dim I As Integer
Dim Col As Integer
Col = Cells(2, 2).Value + 2 'Attribution de la colonne à modifier
Cells(3, Col).Clear
For I = 5 To 503
Cells(I, Col).Clear
Next I
End Sub
pour ceux qui du type de fichier analyser, en voici un exemple :
G01G40X-9.192Y-71.879
G00Z2
X-8.207Y40.093
G1Z-4
G01G41X-10.554Y30.956D190
G03X0.64Y25.992R16
G02X0.64Y25.992I-0.64J-25.992
G03X12.066Y30.398R16
G01G40X10.172Y39.64
G00Z2
( CONT EBA 233*300.3 FR020 )
(HT-17.5 ET RETRAIT)
N10M106T10
M98P2019
G00G54X-201.5Y110.5M03B0S5400
G43Z10H10M8T188
#100=-8.5
M98P2192L3
G00Z10.
( DECROT RESTE MATIERE A 17.5 080 )
N188M106T188
M98P2019
G0G90G54X-234.5Y-215.5M03B0S24pour rappel, mon besoin est de récupérer tous les T... après le M106
Si je comprends bien ton code, il ne prend qu'un seul fichier, c'est bien cela ?
Dans ce cas, pourquoi écris-tu ?
mais je ne peux faire de recherche que sur 10 fichiers à la fois
D'autre part, qu'est-ce qui est fastidieux ?
les manipulations sont très fastidieuses
quelles manipulations ?
Voici une fonction qui ouvre tous les fichiers xlsx d'un dossier les uns après les autres.
Option Explicit
Sub balayagedossier()
Dim wbk1 As Workbook, wbk2 As Workbook
Dim MonRepertoire, Repertoire As FileDialog, monFichier$
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
Repertoire.Show
If Repertoire.SelectedItems.Count = 0 Then Exit Sub
MonRepertoire = Repertoire.SelectedItems(1) & "\"
Set wbk1 = ThisWorkbook
monFichier = Dir(MonRepertoire & "*.xlsx")
Do While monFichier <> ""
Debug.Print monFichier
Set wbk2 = Workbooks.Open(MonRepertoire & monFichier)
' ici le traitement du fichier ouvert
Application.DisplayAlerts = False
wbk2.Close False
Application.DisplayAlerts = True
monFichier = Dir
Loop
End SubPar 10, car chaque recherche retranscrit le résultat dans une colonne du tableau et que celui ci a10 colonnes. Oui ce nombre pourrait être modifié.
Fastidieux car la manipulation pour rechercher le fichier qu'on veux analyser, copier la cible dans la colonne,puis la purger et ce pour chaque fichier...je t'assure c'est long et les manipulations nombreuses. Je t'envoie une capture d'écran cette après-midi.
pour ton code, au delà du fait que je ne sait absolument pas comment l'intégrer dans ma macro, mes fichiers ne sont que des .doc pas des .xlsx ...
comme je le demandais as-tu fichier .doc (tu es sûr de l'extension ?), et as-tu ton tableau dans lequel tu veux mettre tes données ?
Un programme plus simple qui va à l'infini ...
Option Explicit
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement données
If Not ActiveSheet.ListObjects(1).DataBodyRange Is Nothing Then ActiveSheet.ListObjects(1).DataBodyRange.Delete
' lecture
lire chemin
End Sub
Sub lire(chemin As String)
Dim fichier$, ContenuLigne$, ligne As Long, outil$, p%, m%, j%, deb%
ligne = 2
fichier = Dir(chemin & "*.txt")
Do While fichier <> ""
Open chemin & fichier For Input As #1
Do While Not EOF(1)
Line Input #1, ContenuLigne
outil = ""
' ton code ====================
p = InStr(1, ContenuLigne, ")")
If p = 0 Then 'Vertifie que l'on est pas dans un commentaire
deb = InStr(1, ContenuLigne, "T") 'Trouve la présence d'un T et retourne sa position
m = InStr(1, ContenuLigne, "M") 'Trouve la présence d'un M et retourne sa position
j = InStr(1, ContenuLigne, "M201") 'elimine le cas d'une operation de detction bris d'outil
If deb <> 0 And m <> 0 And j = 0 Then
If m < deb Then
outil = Mid(ContenuLigne, deb + 1)
End If
End If
End If
' fin de ton code =============
If outil <> "" Then
Cells(ligne, 1) = fichier
Cells(ligne, 2) = outil
ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
Loop
Close #1
fichier = Dir
Loop
End Subcette proposition te convient-elle ?
salut,
désolé j'ai du mettre le sujet en attente quelques jours.
déjà merci de ton retour.
j'ai essayé ton pgm (sans rien modifier à la macro) et soucis !
le type de fichier n'est pas pris en compte . le chemin ouvre bien les dossiers et sous dossiers mais n'affiche pas le fichier pour ensuite pouvoir l'analyser.
dois je modifier quelque chose a ton code ?
j'ai vérifié une chose... le type de fichier est ...: fichier ! il n'y a pas d'extension .doc ou .txt .
possible de les lires en utilisant le bloc notes
je te joint une capture d’écran du fonctionnement actuel.
merci de ton aide
Option Explicit
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement données
If Not ActiveSheet.ListObjects(1).DataBodyRange Is Nothing Then ActiveSheet.ListObjects(1).DataBodyRange.Delete
' lecture
lire chemin
End Sub
Sub lire(chemin As String)
Dim fichier$, ContenuLigne$, ligne As Long, outil$, p%, m%, j%, deb%
ligne = 2
fichier = Dir(chemin)
Do While fichier <> ""
Open chemin & fichier For Input As #1
Do While Not EOF(1)
Line Input #1, ContenuLigne
outil = ""
' ton code ====================
p = InStr(1, ContenuLigne, ")")
If p = 0 Then 'Vertifie que l'on est pas dans un commentaire
deb = InStr(1, ContenuLigne, "T") 'Trouve la présence d'un T et retourne sa position
m = InStr(1, ContenuLigne, "M") 'Trouve la présence d'un M et retourne sa position
j = InStr(1, ContenuLigne, "M201") 'elimine le cas d'une operation de detction bris d'outil
If deb <> 0 And m <> 0 And j = 0 Then
If m < deb Then
outil = Mid(ContenuLigne, deb + 1)
End If
End If
End If
' fin de ton code =============
If outil <> "" Then
Cells(ligne, 1) = fichier
Cells(ligne, 2) = outil
ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
Loop
Close #1
fichier = Dir
Loop
End SubUne fois le tableau obtenu, tu peux faire des tris, des recherches, des filtres et des TCD pour t'aider dans l'analyse.
SUPER CA MARCHE SUPER BIEN !!!!
GENIAL MILLE MERCI
le zip ....il sert a quoi ? stp
et je viens de me rendre compte de quelque chose...
dans certain pgm la syntaxe est differentes, parfois au lieu de M106 T... , c'est indiqué T...M106 ou T...M06 ou encore M06 T...
sans abuser de ta bonté peux tu encore m'aider ?
et également ,
l'analyse se fait actuellemnt a partir du sous dossier qui contient le pgm
mais est il possible de faire l'analyse en ne sélectionnant que le dossier hôte qui contient les sous dossiers eux mêmes contenant d'autres sous dossiers puis enfin les pgm ?
l'analyse se fait actuellemnt a partir du sous dossier qui contient le pgm
mais est il possible de faire l'analyse en ne sélectionnant que le dossier hôte qui contient les sous dossiers eux mêmes contenant d'autres sous dossiers puis enfin les pgm ?
je vais faire une lecture récursive dans toute la nomenclature de dossiers à partir d'un dossier sélectionné, ok
dans certain pgm la syntaxe est differentes, parfois au lieu de M106 T... , c'est indiqué T...M106 ou T...M06 ou encore M06 T...
peux-tu me donner un exemple d'une ligne complète ? ou des exemples ...
le zip était une collection de fichiers que je me suis faite
voici quelques exemples des pgm :
(DEBUT PROGRAMME)
(FRAISE 025 ISC R4 )
M106T11
M98P2086
M63
G90G00G54X-70.011Y-74.782M03S6000B0
M61
G43H11Z10.M08T66
G01Z-8.F2000
G01G41D11X-45.667Y-64.269F1000
(TOURTEAU 080 ALU)
M106T66
M98P2086
M63
G90G00G54X-41.636Y-161.480M03S4000B0
M61
G43H66Z10.M08T6
(DEBUT PROGRAMME)
(PROGRAMME OK LE 30/01/2019)
(TOURTEAU 050 DIAMANT)
(SURFACAGE PATTE)
N6T6M106
T10
M98P1500
M63
G0G90G54X0Y-235B0.M3S10000
M61
(FRAISE 020 COURTE)
(PATTE B-160.211)
N10T10M106
T29
M98P1500
M63
G0G90G54.1P6X21.515Y-212.395B-160.211M3S6500
M61
G43H10Z263.929M8
(FORET A POINTER O16 B180)
(POINTAGE 4M6 B180)
N63T63M106
T65
M98P1500
M63
(FRAISE O16 EB OREILLES)
M106T18
T11
M98P5100
M63
Comme j'avais repris ton programme, cela veut dire qu'il n prenait déjà pas tout en compte.
Si je comprends bien, il faut prendre la ligne où on trouve M106 ?
oui "M106" mais aussi "M06" et on viens de m'apprendre que cela peut aussi etre "M6"
Tu as avec ceci toutes les lignes qui contiennent M106 de tous les dossiers contenus dans le dossier choisi, à l'état brut (toute la ligne) > tu peux ensuite avec des formules classiques en tirer ce que tu souhaites.
Option Explicit
Dim ligne As Long
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement données
If Not ActiveSheet.ListObjects(1).DataBodyRange Is Nothing Then ActiveSheet.ListObjects(1).DataBodyRange.Delete
' lecture
ligne = 2
lire chemin
End Sub
Sub lire(chemin As String)
Dim fso, SourceFolder, SubFolder
Dim fichier$, ContenuLigne$
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(chemin)
fichier = Dir(chemin)
Do While fichier <> ""
Open chemin & fichier For Input As #1
Do While Not EOF(1)
Line Input #1, ContenuLigne
If InStr(1, ContenuLigne, ")") = 0 Then 'Vertifie que l'on est pas dans un commentaire
If InStr(1, ContenuLigne, "M106") <> 0 Then
Cells(ligne, 1) = fichier
Cells(ligne, 2) = ContenuLigne
ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
End If
Loop
Close #1
fichier = Dir
Loop
For Each SubFolder In SourceFolder.subfolders
lire SubFolder.Path & "\"
Next SubFolder
End Sub