Récupération textes définis
Bonjour le forum
Après plusieurs recherches sans grand succès, je reviens vers les experts de ce forum.
Je voudrais récupérer dans plusieurs fichiers txt des textes situés à côté de textes "permanents".
Exemple:
Blabla = Texte à récupérer 1
Boubou = Texte à récupérer 2
Etc......
Blabla et Boubou se retrouveront dans tous les fichiers.
Le séparateur n'est pas forcement "=", ce peux être ":" voire même un simple espace.
Si possible récupérer ces données sans ouvrir les fichiers txt.
Les données seront récupérées dans un classeur (une ligne par fichier txt)
Merci pour toute aide.
Bonne soirée
Bonjour
Merci h2so4 pour ta proposition.
Je t'avoue qu'en regardant le code je suis perdu.
Petite précision par rapport à mon premier post, tous les fichiers texte
se trouvent dans un même dossier( "C:\Users\JP\Desktop\Test\" ).
Je joint également un classeur montrant le résultat que je souhaite et un exemple de fichier txt.
Merci encore pour ton attention h2so4
Bonsoir,
je t'ai paramétré le fichier en fcontion de tes indications.
Salut h2so4
Sauf erreur de ma part tu as renvoyé le même classeur avec la même macro.
oups
Bonjour à tous
h2so4 j'ai testé la macro mais ....rien ne se passe (il n'y a pas de message d'erreur).
D'après l'architecture de ton tableau il faut rentrer le chemin des fichiers en A2 puis
indiquer les mots clé pour la recherche en B2 et C2 .
Pour mon utilisation le chemin d'accès et les mots clés son toujours les mêmes et je
pensais donc qu'ils seraient intégrés directement dans la macro.
Comme la macro ne réagis pas j'ai du mal à saisir le fonctionnement de ton code.
Je vais encore fouiller.
De toute façon un grand merci pour ton aide.
Bonsoir,
je te confirme que cette macro fonctionne sans problème chez moi,
je t'ai fait une version avec une option de traçage qui devrait te permettre de déterrminer où est l'erreur, le résultat du traçage se trouve dans sheet2.
tu peux m'envoyer le résultat, si tu ne trouves pas l'erreur par toi-même
Bonjour
h2so4
La macro fonctionne en partie, je m'explique.
Tout d'abord il manquait les majuscules à Blabla et Boubou.
Un fois cela corrigé voici ce qui se passe:
Le nom du fichier txt est inscrit.
Le texte situé à côté de Blabla est inscrit.
Ensuite j'ai un message d'erreur:
Erreur d'exécution'5':
Argument ou appel de procédure incorrect
Le texte situé à côté de Boubou n'est pas inscrit.
Pourrais tu rajouter des commentaires aux lignes de code car j'ai du mal à l'interpréter.
Merci pour ton aide h2so4
Bonsoir,
1) commentaires ajoutés
2) recherche adaptée pour être insensible aux minuscules ou majuscules
3) erreur 5 en principe corrigée ( à tester sur tes fichiers)
h2so4
Tu est d'une efficacité redoutable.
çà fonctionne très bien.
Les commentaires vont m'être très précieux.
Quoi te dire sinon un grand merci.
Chapeau bas h2so4
Bonjour le forum
h2so4
Si tu peux lire cette suite à mon post précédent voici mon problème.
J'ai légèrement remanié ta macro pour intégrer "en dur" l'accès au dossier contenant les fichiers txt.
La macro fonctionne remarquablement à partir de mes fichiers exemples mais me pose problème avec mon "vrai" dossier.
Ce dossier est issu de fichiers RTF convertis en fichiers txt.
Lorsque je lance la macro j'ai un message d'erreur:
Errerur d'éxecution'62':
L'entrée dépasse la fin de fichier
Tout celà au niveau du code
t = Input(LOF(1), #1)
Je ne trouve pas
Voici le code remanié
Option Explicit
Sub Trouvertexte()
Dim Résultat As Object
Dim dc As String
Dim ch As String
Dim s As String
Dim s1 As String
Dim f As String
Dim l As String
Dim t As String
Dim i As Integer
Dim p As String
Dim vp As String
Dim objShell As Object
Dim objFolder As Object
' Résultat feuille avec paramètres et résultats
Set Résultat = Worksheets("Résultat")
' dc = dernière colonne utlisée dans ésultat
dc = Résultat.Range("ZB2").End(xlToLeft).Column
'Set objShell = CreateObject("Shell.Application")
'Ouvre une fenêtre Window pour sélectionner le dossier
'Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
'If objFolder Is Nothing Then
'message
'MsgBox "Abandon opérateur", vbCritical, "Annulation"
'sinon
'Else
'Ch = répertoire choisi
'ch = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
' ch = répertoire dans lequel chercher les fichiers
ch = "C:\Users\JP\Desktop\Résultats txt\"
' on cherche le dernier "\" à sa gauche on aura le chemin d'accès (répertoire)
' à sa droite le nom du fichier
s = InStr(ch, "\")
While s <> 0
s1 = InStr(s + 1, ch, "\")
' on a trouvé le dernier "\"
If s1 = 0 Then
' on sauve le répertoire
ch = Left(ch, s)
End If
s = s1
Wend
' f contient le nom du premier fichier correspondant au filtre
f = Dir(ch)
' l pointeur de ligne en cours sur Résultat
l = 2
'tant qu'il y a un fichier
While f <> ""
l = l + 1
' on ouvre le fichier
Open ch & f For Input As #1
' on écrit le nom du fichier en cours sur Résultat
'Résultat.Cells(l, 1) = f
' on charge le contenu du fichier dans t
t = Input(LOF(1), #1)
' on parcourt tous les paramètres
For i = 2 To dc
' p est le paramètre en cours
p = Résultat.Cells(2, i)
' on cherche p dans t
s = InStr(UCase(t), UCase(p))
' on a trouvé p dans t
If s <> 0 Then
' on cherche la fin du texte (caractère nouvelle ligne) qui suit le paramètre
s1 = InStr(s, t, Chr(13))
' pas de nouvelle ligne on est à la fin du fichier
If s1 = 0 Then
' vp texte après le paramètre
vp = Mid(t, s + Len(p))
Else
vp = Mid(t, s + Len(p), s1 - (s + Len(p)))
End If
' on met vp dans Résultat après l'avoir "nettoyé"
Résultat.Cells(l, i) = Application.WorksheetFunction.Clean(Trim(Replace(Replace(vp, "=", ""), ":", "")))
vp = ""
Else
End If
Next i
Close 1
' on prend le fichier suivant qui correspond au filtre
f = Dir()
Wend
Set Résultat = Nothing
'End If
End Sub
Bonjour,
tentative de correction sur le code remanié. à tester car dépendant de tes fichiers dont je ne dispose pas.
Option Explicit
Sub Trouvertexte()
Dim Résultat As Object
Dim dc As String
Dim ch As String
Dim s As String
Dim s1 As String
Dim f As String
Dim l As String
Dim t As String
Dim i As Integer
Dim p As String
Dim vp As String
Dim objShell As Object
Dim objFolder As Object
Dim trouvé As Boolean
' Résultat feuille avec paramètres et résultats
Set Résultat = Worksheets("Résultat")
' dc = dernière colonne utlisée dans ésultat
dc = Résultat.Range("ZB2").End(xlToLeft).Column
'Set objShell = CreateObject("Shell.Application")
'Ouvre une fenêtre Window pour sélectionner le dossier
'Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
'If objFolder Is Nothing Then
'message
'MsgBox "Abandon opérateur", vbCritical, "Annulation"
'sinon
'Else
'Ch = répertoire choisi
'ch = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
' ch = répertoire dans lequel chercher les fichiers
ch = "C:\Users\JP\Desktop\Résultats txt\"
' on cherche le dernier "\" à sa gauche on aura le chemin d'accès (répertoire)
' à sa droite le nom du fichier
s = InStr(ch, "\")
While s <> 0
s1 = InStr(s + 1, ch, "\")
' on a trouvé le dernier "\"
If s1 = 0 Then
' on sauve le répertoire
ch = Left(ch, s)
End If
s = s1
Wend
' f contient le nom du premier fichier correspondant au filtre
f = Dir(ch)
' l pointeur de ligne en cours sur Résultat
l = 2
'tant qu'il y a un fichier
While f <> ""
trouvé = False
' on ouvre le fichier
Open ch & f For Input As #1
' on écrit le nom du fichier en cours sur Résultat
'Résultat.Cells(l, 1) = f
' on charge le contenu du fichier dans t
While Not EOF(1)
Input #1, t
' on parcourt tous les paramètres
For i = 2 To dc
' p est le paramètre en cours
p = Résultat.Cells(2, i)
' on cherche p dans t
s = InStr(UCase(t), UCase(p))
' on a trouvé p dans t
If s <> 0 Then
If trouvé = False Then trouvé = True: l = l + 1
vp = Mid(t, s + Len(p))
' on met vp dans Résultat après l'avoir "nettoyé"
Résultat.Cells(l, i) = Application.WorksheetFunction.Clean(Trim(Replace(Replace(vp, "=", ""), ":", "")))
vp = ""
Exit For
End If
Next i
Wend
Close 1
' on prend le fichier suivant qui correspond au filtre
f = Dir()
Wend
Set Résultat = Nothing
'End If
End Sub
Merci pour ta réponse h2so4
Comme d'habitude ce que tu propose marche.
Je te soumet quand même un cas particulier propre à mes fichiers.
Entre autre je veux récupérer une partie du texte ci-dessous:
Numéro de série : 27125,0140
La macro récupère 27125
Je voudrais récupérer 27125,0140 et même si c'est possible uniquement 0140.
Celà concerne seulement une des lignes que je veux traiter.
Merci encore pour ton aide .
re-Bonjour,
à tester
Option Explicit
Sub Trouvertexte()
Dim Résultat As Object
Dim dc As String
Dim ch As String
Dim s As String
Dim s1 As String
Dim f As String
Dim l As String
Dim t As String
Dim i As Integer
Dim p As String
Dim vp As String
Dim objShell As Object
Dim objFolder As Object
Dim trouvé As Boolean
' Résultat feuille avec paramètres et résultats
Set Résultat = Worksheets("Résultat")
' dc = dernière colonne utlisée dans ésultat
dc = Résultat.Range("ZB2").End(xlToLeft).Column
'Set objShell = CreateObject("Shell.Application")
'Ouvre une fenêtre Window pour sélectionner le dossier
'Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
'If objFolder Is Nothing Then
'message
'MsgBox "Abandon opérateur", vbCritical, "Annulation"
'sinon
'Else
'Ch = répertoire choisi
'ch = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
' ch = répertoire dans lequel chercher les fichiers
ch = "C:\Users\JP\Desktop\Résultats txt\"
' on cherche le dernier "\" à sa gauche on aura le chemin d'accès (répertoire)
' à sa droite le nom du fichier
s = InStr(ch, "\")
While s <> 0
s1 = InStr(s + 1, ch, "\")
' on a trouvé le dernier "\"
If s1 = 0 Then
' on sauve le répertoire
ch = Left(ch, s)
End If
s = s1
Wend
' f contient le nom du premier fichier correspondant au filtre
f = Dir(ch)
' l pointeur de ligne en cours sur Résultat
l = 2
'tant qu'il y a un fichier
While f <> ""
trouvé = False
' on ouvre le fichier
Open ch & f For Input As #1
' on écrit le nom du fichier en cours sur Résultat
'Résultat.Cells(l, 1) = f
' on charge le contenu du fichier dans t
While Not EOF(1)
Line Input #1, t
' on parcourt tous les paramètres
For i = 2 To dc
' p est le paramètre en cours
p = Résultat.Cells(2, i)
' on cherche p dans t
s = InStr(UCase(t), UCase(p))
' on a trouvé p dans t
If s <> 0 Then
If trouvé = False Then trouvé = True: l = l + 1
vp = Mid(t, s + Len(p))
' cas spécial du numéro de série
If Left(p, 15) = "Numéro de série" Then
s1 = InStr(vp, ",")
If s1 <> 0 Then
vp = Replace(vp, Left(vp, s1), "")
End If
End If
' on met vp dans Résultat après l'avoir "nettoyé"
Résultat.Cells(l, i) = Application.WorksheetFunction.Clean(Trim(Replace(Replace(vp, "=", ""), ":", "")))
vp = ""
Exit For
End If
Next i
Wend
Close 1
' on prend le fichier suivant qui correspond au filtre
f = Dir()
Wend
Set Résultat = Nothing
'End If
End Sub
Et hop
Aussitôt essayé aussitôt fonctionnel.
La force est avec toi maître Jedi h2so4
Merci beaucoup