importer ficher texte

[gege21]

bonjours

je doit importe des ficher texte dons le nom change toujours
comment faire ??

 

[Staple1600]

Re : importer ficher texte

Bonsoir


Tu peux essayer d'adapter le code ci-dessous à ta problématique

Ce code tel quel, importera tous les fichiers textes présents dans le répertoire renseigné dans le code (ici: C:\TEMP )

PS: les données dans les fichiers texte étant séparées ici par un point-virgule.

Sub import()
'auteur macro d'origine: jindon
    Dim myDir$, fn$, txt$, sepa$, a(), n As Long, i As Long, ff As Integer
    sepa = ";"
    myDir = "C:\TEMP\"
    fn = Dir(myDir & "*.txt")
    Do While fn <> ""
        ff = FreeFile
        Open myDir & fn For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            n = n + 1: ReDim Preserve a(1 To n)
            a(n) = Split(txt, sepa)
         Loop
        Close #ff
        fn = Dir()
    Loop
    With ThisWorkbook.Sheets(1).[a1]
        For i = 1 To n
            .Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
        Next
    End With
End Sub

 

[gege21]

Re : importer ficher texte

merci jm pour ta réponse

mais je me suis mal exprime le nom de mon ficher texte change bien régulièrement
et je voudrai entre sont nom dans une cellule pour l'importe a la suis comme
dans ta macro
que serai les modif a faire
merci par avance

 

[Staple1600]

Re : importer ficher texte

Re

Essayes cette macro


Il faut un fichier texte nommé (ici par exemple, dans C:\TEMP) : test1.txt
Dans la feuille 1, cellule A1, saisir : test1.txt

Puis lancer la macro ci-dessous

Sub test_import()
Dim chemin$, fichier$
chemin = "C:\TEMP\"
fichier = ThisWorkbook.Sheets(1).[a1].Text
Workbooks.OpenText chemin & fichier
end sub

 

[gege21]

Re : importer ficher texte

merci jm

en faite il forai un mixe des deux macro
que je saisisse le nom des .txt dans une cellule
et que les ficher soit tous importe dans la meme feuille et la suite

et sans doublon

 

[Staple1600]

Re : importer ficher texte

re


dans un répertoire donné, il ne peut pas y avoir de fichiers en double
(qui ont le même nom)

Pourquoi ne veux-tu pas utiliser la macro de mon 1er message?

Elle fait ce que tu souhaites (ou presque)

Pas besoin d'avoir le nom des fichiers dans une feuille excel

puisque la macro parcourt tout le dossier et importe tous les fichiers texte trouvés.

 

[gege21]

Re : importer ficher texte

c'est vreai elle est même très bien mais dans mon répertoire il y a d'autre ficher texte que je n'ai pas besoin et t'a 1'er macro importe tout d'où le besoin de marque le nom du txt

merci

 

[kiki29]

Re : importer ficher texte

Salut,peut-être comme cela

Option Explicit

Sub SelFichier()
Dim Fichier As Variant

    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Texte,*.txt", 1, _
                                          "Sélectionner un fichier", , MultiSelect:=False)
    If TypeName(Fichier) = "Boolean" Then Exit Sub
    
    DoEvents
    Application.ScreenUpdating = False

    Workbooks.OpenText Fichier
    
    Application.ScreenUpdating = True
End Sub

 

[gege21]

Re : importer ficher texte

merci kiki
mais sa ne va pas

la macro de Jm ci-dessous est tres bien il faut juste que je puisse entre le nom du texte dans une cellule

Sub import()
'auteur macro d'origine: jindon
Dim myDir$, fn$, txt$, sepa$, a(), n As Long, i As Long, ff As Integer
sepa = ";"
myDir = "C:\TEMP\"
fn = Dir(myDir & "*.txt")
Do While fn <> ""
ff = FreeFile
Open myDir & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
n = n + 1: ReDim Preserve a(1 To n)
a(n) = Split(txt, sepa)
Loop
Close #ff
fn = Dir()
Loop
With ThisWorkbook.Sheets(1).[a1]
For i = 1 To n
.Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
Next
End With
End Sub

 

[Staple1600]

Re : importer ficher texte

Re, bonjour kjin

Finalement je privilégie cette autre approche

Préambule pour tester la macro
1) Dézipper la pièce jointe Ce lien n'existe plus dans C:\Temp
Tu auras alors 4 fichiers : aaa.txt, bbb.txt, ccc.txt et test.xls

2) Ouvres test.xls et cliques sur le bouton pour commencer l'importation.

Est-ce genre de résultats que tu souhaites obtenir ?

Voici le code de la macro utilisée dans la pj

Sub ImportTXTbis()
'auteur macro originale: Andy Pope
Dim strPath$, strFile$, i As Long
strPath = [B1].Text
With ThisWorkbook.Sheets(1)
For i = 4 To .[A4].End(xlDown).Row
strFile = .Cells(i, 1).Text
 Application.ScreenUpdating = False
        With ActiveWorkbook.Worksheets.Add
        ActiveSheet.Move after:=Sheets(ActiveWorkbook.Worksheets.Count)
            With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
                Destination:=.Range("A1"))
                .Parent.Name = Replace(strFile, ".txt", "")
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileSemicolonDelimiter = True
                .TextFileColumnDataTypes = Array(1)
                .Refresh BackgroundQuery:=False
            End With
        End With
        Next i
        End With
Application.ScreenUpdating = False
End Sub

PS: test concluant avec Excel 2000 (je viens de tester avant de poster la pj)

 

[gege21]

Re : importer ficher texte

cela va dans le bon sens

il fraudai que les ficher txt soit sur la même feuille et lien au bout de l'autre
comme dans ta 1 er macro

mes donne .txt sont de se type la
09/01/10;20:00;-2,4;80;-5,4;0,0;5,4;358;0,0;0,0;1007,6;25,4;22,3;29;0,0;-2,4;-2,4
09/01/10;20:30;-2,4;80;-5,4;2,5;2,5;353;0,0;0,0;1007,6;25,4;22,4;30;2,5;-2,4;-2,4
09/01/10;21:30;-2,2;80;-5,2;0,0;2,9;355;0,0;0,0;1008,0;25,4;22,5;30;0,0;-2,2;-2,2
09/01/10;22:00;-2,2;81;-5,0;0,0;4,0;353;0,0;0,0;1008,2;25,4;22,5;29;0,0;-2,2;-2,2
09/01/10;22:30;-2,4;82;-3,7;0,0;0,0;0;0,0;0,0;1008,2;25,4;22,5;29;0,0;-2,4;-2,4
09/01/10;23:00;-2,6;84;-5,0;2,5;4,0;358;0,0;0,0;1008,6;25,4;22,3;29;2,5;-2,6;-2,6
09/01/10;23:30;-2,8;86;-4,8;5,8;6,8;358;0,0;0,0;1008,8;25,4;22,0;29;5,8;-2,8;-2,8
10/01/10;00:00;-2,8;86;-4,8;0,0;7,2;354;0,0;0,0;1008,9;25,4;21,6;29;0,0;-2,8;-2,8
10/01/10;00:30;-2,8;87;-4,7;2,2;7,6;351;0,0;0,0;1009,2;25,4;21,3;29;2,2;-2,8;-2,8
10/01/10;01:00;-2,8;88;-3,6;0,0;0,0;0;0,0;0,0;1009,3;25,4;21,2;29;0,0;-2,8;-2,8
10/01/10;01:30;-2,8;88;-3,6;1,8;1,8;1;0,0;0,0;1009,1;25,4;21,0;29;1,8;-2,8;-2,8
10/01/10;02:00;-2,7;88;-3,5;2,5;2,5;1;0,0;0,0;1009,5;25,4;20,9;29;2,5;-2,7;-2,7
10/01/10;02:30;-2,7;88;-3,5;1,4;1,4;337;0,0;0,0;1009,5;25,4;20,8;29;1,4;-2,7;-2,7

et merci pour le temps que tu me consacre

 

[Staple1600]

Re : importer ficher texte

RE

Et comme cela ?

Sub ImportTXT_B()
'auteur macro originale: Andy Pope
Dim strPath$, strFile$, i As Long
strPath = "C:\temp\"
With ThisWorkbook.Sheets(1)
For i = 1 To .[A65536].End(xlUp).Row 
strFile = .Cells(i, 1).Text
 Application.ScreenUpdating = False
        With ActiveWorkbook.Worksheets("IMPORTATION")
            With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
                Destination:=.[A65536].End(xlUp).Offset(1))
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileSemicolonDelimiter = True
                .TextFileColumnDataTypes = Array(1)
                .Refresh BackgroundQuery:=False
            End With
            .[A1].CurrentRegion.Columns.AutoFit
        End With
        Next i
        End With
Application.ScreenUpdating = False
End Sub

 

[Staple1600]

Re : importer ficher texte

Re

Puisque tu sembles préférer la première approche

Tu auras le choix entre ces deux méthodes

Sub import_der()
'auteur macro d'origine: jindon
    Dim myDir$, fn$, txt$, sepa$, a()
    Dim n As Long, i As Long, j As Long, ff As Integer
    sepa = ";": myDir = "C:\TEMP\"
    With ThisWorkbook.Sheets(1)
    For j = 1 To .[A65536].End(xlUp).Row
        ff = FreeFile
        Open myDir & .Cells(j, 1).Text For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            n = n + 1: ReDim Preserve a(1 To n)
            a(n) = Split(txt, sepa)
         Loop
        Close #ff
      Next j
    With ThisWorkbook.Sheets(2).[a1]
        For i = 1 To n
            .Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
        Next
    End With
    End With
End Sub

 

[Staple1600]

Re : importer ficher texte

Re


Je te mets cette 3ème possibilité qui à l'avantage de mettre les cellules
contenant des dates au format dates

(J'ai testé avec tes données texte de ton précédent message)

Tu as de quoi tester désormais avec tes vrais fichiers textes

En espérant que d'autres ici te proposeront un code plus compact et plus limpide que celui présenté ci-dessous.

Bon week-end

Sub importAvec_AssistantTEXTpourFormat()
Dim a As Workbook, b As Workbook
Dim chemin$: chemin = "C:\TEMP\": Set a = ThisWorkbook
Dim i As Long
Application.ScreenUpdating = False
    With a
        With .Sheets(1)
            For i = 1 To .[A65536].End(xlUp).Row
                Workbooks.OpenText Filename:=.Cells(i, 1).Text, Origin:=xlWindows, _
                    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
                    , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), Array(2, 2), _
                    Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                    Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                    16, 1), Array(17, 1))
                    Set b = ActiveWorkbook
                    b.ActiveSheet.UsedRange.Copy a.Sheets(2).[A65536].End(xlUp).Offset(1)
                    b.Close True
            Next
        End With
        With .Sheets(2)
            .Rows("1:1").EntireRow.Delete
            With .[A1].CurrentRegion
                .Columns.AutoFit
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
            End With
        End With
    End With
Application.ScreenUpdating = True
End Sub

 

[gege21]

Re : importer ficher texte

je vais regarder tes 3 codes mais cela me parais très bien

je te remercie bien JM