Importation d'une sélection lignes de fichiers texte

[nephtys38]

Bonjour à tous,

J'ai besoin de modifier une macro qui me permet d'importer plusieurs fichiers textes d'un dossier dans excel, et je souhaiterais sélectionner seulement quelques lignes de ces fichiers textes.
Voici la macro actuelle:

Sub ImportTextFile()
'code de Coriolan modif par MJ issu de http://www.excel-downloads.com/forum/83569-pb-dimportation-dobjets-dans-une-macro.html
'Dim ceclasseur As String
'Dim monrépertoire As String
'Dim ii As Integer
'monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"

'Stop
chemin = "J:\npai\Invalides\test"
ceclasseur = ThisWorkbook.Name

Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
If fc.Count > 0 Then 'il y a des fichiers
ii = 0
For Each f1 In fc
If Right(f1.Name, 3) = "txt" Or Right(f1.Name, 3) = "TXT" Then  'c'est un fichier texte
'ii = ii + 1
nomtxt = f1.Name
ii = ActiveSheet.Range("a65536").End(xlUp).Row

Workbooks.OpenText Filename:= _
chemin & "\" & f1.Name, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True
'inclu_nom_fichier début
derligne = ActiveSheet.Range("a65536").End(xlUp).Row
Range("A1:A" & derligne).Select
    Selection.Insert Shift:=xlToRight
    Selection.FormulaR1C1 = f1.Name
'inclu_nom_fichier fin
derligne = ActiveSheet.Range("a65536").End(xlUp).Row

'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
Rows(1 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1)
ActiveWorkbook.Close savechanges:=False

End If
Next
End If

'Columns("A:IV").Select
'Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub

Merci

 

[tototiti2008]

Re : Importation d'une sélection lignes de fichiers texte

Bonjour nephtys,

avec OpenText le seul moyen de limiter les lignes est de modifier la valeur de StartRow (à moins de tout importer puis de supprimer les lignes non voulues)
Si tu veux importer des lignes sous condition, il va falloir parcourir chaque ligne du fichier texte pour vérifier si elle doit être importée, par exemple en utilisant les FileSystemObject.

Evidement, avec un exemple des données à importer et une explication sur les critères qui permettent de choisir quelles lignes importer, tu aurais une réponse plus claire.

 

[nephtys38]

Re : Importation d'une sélection lignes de fichiers texte

Se serait pour importer les lignes 25 à 40 de chaque fichiers (qui ont la même structure),
ou encore mieux si c'est possible, seulement les lignes contenant une adresse email...

Cordialement.

 

[MJ13]

Re : Importation d'une sélection lignes de fichiers texte

Bonjour nephtys, Tototo

Voir peut-être cette discussion, sachant qu'on peut remplacer csv par txt:

https://www.excel-downloads.com/threads/fichier-csv-sur-2007.157326/

 

[tototiti2008]

Re : Importation d'une sélection lignes de fichiers texte

Re,
Bonjour Michel,

Peut-être (pas testé)

Sub ImportTextFile()
'code de Coriolan modif par MJ issu de http://www.excel-downloads.com/forum/83569-pb-dimportation-dobjets-dans-une-macro.html
'Dim ceclasseur As String
'Dim monrépertoire As String
Dim ii As Integer, nomtxt As String, Ligne As String, TabLigne, i As Long
Dim fc, f1, fso
'monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"

'Stop
    chemin = "J:\npai\Invalides\test"
    ceclasseur = ThisWorkbook.Name
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fc = fso.GetFolder(chemin).Files
    If fc.Count > 0 Then 'il y a des fichiers
        ii = 0
        For Each f1 In fc
            If UCase(f1.Name) Like "*.TXT" Then  'c'est un fichier texte
                'ii = ii + 1
                nomtxt = f1.Name
                ii = ActiveSheet.Range("a65536").End(xlUp).Row + 1
                Set f1 = fso.OpenTextFile(chemin & "\" & nomtxt, 1, False, -2)
                Do Until f1.AtEndOfStream
                    Ligne = f1.readline
                    If Ligne Like "*@*.*" Then
                        TabLigne = Split(Ligne, ";")
                        For i = LBound(TabLigne) To UBound(TabLigne)
                            ActiveSheet.Cells(ii, i + 1).Value = TabLigne(i)
                        Next i
ii=ii+1
                    End If
                Loop
                f1.Close
            End If
        Next
    End If
    Set f1 = Nothing
    Set fc = Nothing
    Set fso = Nothing
End Sub

 

[nephtys38]

Re : Importation d'une sélection lignes de fichiers texte

Merci pour vos réponses.
Le code de Tototiti fonctionne.

Bonne journée!

 

[nephtys38]

Re : Importation d'une sélection lignes de fichiers texte

Re...
J'ai une erreur d'exécution 1004 : "erreur définie par l'application ou par l'objet", d'où cela peut-il provenir?
le debogeur m'indique cette ligne

 ActiveSheet.Cells(ii, i + 1).Value = TabLigne(i)