Lecture d'un .txt et copie de données ac critére dans Excel

Bonjour à tous,

Je souhaite:

• lire un fichier .txt
• lire le fichier et dés qu'il tombe sur la ligne correspond à une cellule

AssyNumber=Cells(lCount,4)

- Descendre de 3 ligne et lire après

CritR=Cells(1,4)

les 5 prochains caractére sur la droite

- les inscrire dans la colonne 19, même ligne que AssyNumber

Voici mon code mais je suis un peu coincé. Je joins mes fichiers Excel et .txt. J'imagine que l'opération va être bien lourde, donc j'essaye de faire un code assez light pour pouvoir le faire rouler assez facilement.

Sub Toollength()

On Error GoTo errH

    Dim Tape, Path, Assy As String
    Dim lCount As Integer
    Dim index As Integer

    Dim myFile As String, text As String
    Dim F As Long
    Dim x As Integer

    lCount = 2

    For Each rRow In Sheets("ToolsLength").UsedRange.Rows

    lCount = lCount + 1

    Tape = Cells(lCount, 2)
    AssyNumber = Cells(lCount, 4)
    CritR = Cells(1, 4)

                    If Tape = "" Then
                        Exit Sub
                    Else
                        On Error GoTo errNull

                        myFile = "C:\Temp\o13158.mak"

                        F = FreeFile
                        x = 1

                        Open myFile For Input As F
                        Do Until EOF(F)
                        Line Input #F, text

                            If InStr(Right(text, 5), Assy) > 0 Then
                            rRow.Cells(lCount, 19).Value = F
                            rRow.Cells(lCount, 20).Value = text

                            x = x + 1

                            End If
                    Loop
errNull:
                    rRow.Cells(18).Value = "Pas Trouvé"
                    End If
            'End If
    Next rRow

errH:
End Sub

Petit Up,

J'ai pas mal avancé de mon coté, j'ai pu récupérer une donnée, de manière assez propre, cela tourne correctement. C'est peut être pas très rapide ni optimal, mais cela à au moins le mérite de fonctionner. Je souhaite modifier 2 choses, mais cela ne fonctionne pas.

En faite, je souhaite pouvoir indexer la localisation de mon fichier en fonctionne de valeurs de mes cellules. Par exemple, dans le répertoire

C:\Users\crouvillois\Desktop\o

je dispose des fichiers portant les noms des cellules. Pour chaque nom de fichier, il y a des identifications "AssyID" 2 colonnes plus loin. Je veux donc chercher dans les fichiers portant le nom "TAPE", les lignes comportant les identifications "AssyID". Mais pour l'instant je ne sais pas comment faire. Si j'essaye de remplacer mon Constant par une position de la cellule cela ne marche pas ... Avez vous une idée ?

Merci pour votre aide

Sub SearchTextFile()
     Const strFileName = "C:\Users\crouvillois\Desktop\o13158.mak"
     Const strSearch = "AS-00411"
     Dim f As Integer
     Dim lngLine As Long
     Dim blnFound As Boolean
     Dim i As Variant
     Dim iRow As Long, iCol As Long
     Dim strLine As String
     Dim Tool As String

     iCol = 19

     iRow = 3

 'For i = Cells(3, 4) To Cells(9, 4)

    'strSearch =

     f = FreeFile
     Open strFileName For Input As #f

     Do While Not EOF(f)
         lngLine = lngLine + 1
         Line Input #f, strLine
         If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                 'Cells(1, 2) = lngLine

                Line Input #f, strLine
                Line Input #f, strLine
                Line Input #f, strLine

                Cells(iRow, iCol) = Mid(strLine, 21, 6)

            blnFound = True
            Exit Do
        End If

     Loop
     Close #f
     If Not blnFound Then
         MsgBox "Search string not found", vbInformation
     End If
   '  Next

 End Sub

bonjour,

une proposition sur base de ce que j'ai compris

Sub SearchTextFile()
    Const rep = "C:\Users\crouvillois\Desktop\"
    i = 3
    While Cells(i, 2) <> ""
        strFileName = rep & "O" & Cells(i, 2) & ".mak" 'fichier correspondant à la tape
        strFileName = Dir(strFileName) 'vérifie si le fichier existe
        If strFileName <> "" Then
            iCol = 19
            f = FreeFile
            strSearch = Cells(i, 4)
            Open rep & strFileName For Input As #f
            Do While Not EOF(f)
                lngLine = lngLine + 1
                Line Input #f, strLine
                If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                    Line Input #f, strLine
                    Line Input #f, strLine
                    Line Input #f, strLine
                    Cells(i, iCol) = Mid(strLine, 21, 6)
                    blnFound = True
                    Exit Do
                End If
            Loop
            Close #f
            If Not blnFound Then
                MsgBox "Search string not found in file " & strFileName, vbInformation
            End If
        End If
        i = i + 1
    Wend
End Sub

OMG ca marche ... Je pensais ne jamais réussir à faire cela ....

Est-il possible de compléxifier la méthode ? La réalité est que mes fichiers sont dans le répertoire:

W:\MKC\MFG\PROD\CNC\206400

ou

W:\MKC\MFG\PROD\CNC\206500

A la suite de cela, ils portent le nom

\o (ou O)"TAPE"

Avec TAPE la colonne B

Puis

\0(REV)

Avec REV la colonne C

Donc par exemple:

W:\MKC\MFG\PROD\CNC\206400\10127\01

Puis là on trouve le fichier o10127.mak et on l'étudie. Comme est-il possible d'étudier cela ?

re-bonjour,

à tester

Sub SearchTextFile()
    rep1 = "W:\MKC\MFG\PROD\CNC\"
    i = 3
    While Cells(i, 2) <> ""
        rep = rep1 & Cells(i, 1) & "\o" & Cells(i, 2) & "\0" & Replace(Cells(i, 3), "REV ", "") & "\"
        strFileName = rep & "o" & Cells(i, 2) & ".mak"
        strFileName = Dir(strFileName)
        If strFileName <> "" Then
            iCol = 19
            iRow = 3
            f = FreeFile
            strSearch = Cells(i, 4)
            Open rep & strFileName For Input As #f
            Do While Not EOF(f)
                lngLine = lngLine + 1
                Line Input #f, strLine
                If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
                    Line Input #f, strLine
                    Line Input #f, strLine
                    Line Input #f, strLine
                    Cells(i, iCol) = Mid(strLine, 21, 6)
                    blnFound = True
                    Exit Do
                End If
            Loop
            Close #f
            If Not blnFound Then
                MsgBox "Search string not found in file " & strFileName, vbInformation
            End If
        End If
        i = i + 1
    Wend
End Sub

Ca me donne une erreure;

 Erreur d'éxécution:'53':
Fichier Introuable

Il me pointe sur:

strFileName = Dir(strFileName)

j'ai essayé de changer le répertoire, c'est n'est pas le probléme.

J'ai changé

rep = rep & Cells(i, 1) & "\o" & Cells(i, 2) & "\0" & Replace(Cells(i, 3), "REV ", "") & "\"

et

rep = "W:\MKC\MFG\PROD\CNC\"

par

rep = rep & "\O" & Cells(i, 2) & "\0" & Replace(Cells(i, 3), "REV ", "") & "\"

et

rep = "W:\MKC\MFG\PROD\CNC\206400"

Mais cela me donne toujours une erreur

Car va d'abord essayé de trouver les fichiers dans 206400 car ils sont très nombreux.

Il me trouve la premiere valeur mais les suivantes ...

bonjour,

ajoute une instruction

msgbox strfilename

avant l'instruction

strfilename=dir(strfilename)

et vérifie le nom du fichier (et son répertoire) affiché

Pour le premier c'est bon:

W:\MKC\MFG\PROD\CNC\206400\O10127\04\o10127.mak

Après c'est moins bon, je pense qu'il reste coincé dans la boucle:

W:\MKC\MFG\PROD\CNC\206400\O10127\04\\04\o10127.mak

Je pense qu'il sortir du répertoire ? Je pense que l'incrémentation ne s'effectue pas correctement ...

bonsoir,

au temps pour moi, j'ai corrigé mon dernier code. voir ci-dessus

Je n'en reviens pas, tout fonctionne. C'est incroyable. L'aisance avec laquelle tu as compris mon problème ...