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

Bonsoir,

voir proposition en annexe

20chercherparam.xlsm (17.69 Ko)

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

11nouveau-document-texte.txt (158.00 Octets)

Bonsoir,

je t'ai paramétré le fichier en fcontion de tes indications.

14chercherparam.xlsm (17.69 Ko)

Salut h2so4

Sauf erreur de ma part tu as renvoyé le même classeur avec la même macro.

oups

13chercherparam.xlsm (17.99 Ko)

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

10chercherparam.xlsm (19.91 Ko)

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)

20chercherparam.xlsm (21.79 Ko)

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

Rechercher des sujets similaires à "recuperation textes definis"