Discussion :

[baillargeois]

Bonjour,

Débutant en VBA, après pas mal de recherches je n'arrive pas à résoudre mon problème... je souhaite importer, sans mise en forme, plusieurs fichiers texte contenu dans un dossier data/ dans la colonne A d'une feuille excel. J'ai utilisé ce code trouvé sur internet qui fonctionne très bien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Sub on_y_va() 'ouvre une boite de dialogue qui permet de sélectionner le dossier où se trouvent les fichiers
    Range("A1:A100000").ClearContents 'supprime tout ce qui est sur la feuille active
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        aspirer monRepertoire
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub
 
Sub aspirer(Repertoire As String) 'importe tous les fichiers les uns à la suite des autres dans la première colonne
 
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim ws As Worksheet, wrecap As Worksheet
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".txt" Then
 
            N = FreeFile
            Open fichier For Input As #N
 
         i = 0
         k = Range("A100000").End(xlUp).Row
           Do While Not EOF(1)
                Line Input #N, contenu
                i = k
                Cells(i, 1).Value = contenu
                k = k + 1
            Loop
 
 
            Close #N
        End If
    Next fichier
 
 
End Sub

Je souhaiterais désormais dans la colonne B renseigner sur chaque ligne le nom du fichier texte dont est issu la donnée. Mes tentatives n'ont pas abouti jusqu'ici, pouvez vous m'aider ?

Par ailleurs est il possible de se passer de la boite de dialogue pour sélectionner mes fichiers textes (ils sont en effet toujours stockés dans le dossier "data" situé dans le même dossier que mon classeur) ?

Merci

[jerome.vaussenat]

Salut,

Voici une proposition de code pour faire ce que tu veux.

Il te reste à modifier le chemin d'accès qui est à mettre au début du code entre les " ".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Dim posi_slash As Integer
 
Sub on_y_va() 'ouvre une boite de dialogue qui permet de sélectionner le dossier où se trouvent les fichiers
    Dim monRepertoire As String
 
    Range("A1:B100000").ClearContents 'supprime tout ce qui est sur la feuille active
    monRepertoire = "le chemin d'accès à tes fichiers"
    posi_slash = Len(monRepertoire) + 2
    aspirer monRepertoire
End Sub
 
Sub aspirer(Repertoire As String) 'importe tous les fichiers les uns à la suite des autres dans la première colonne
 
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim ws As Worksheet, wrecap As Worksheet
    Dim nomcourt As String
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".txt" Then
            N = FreeFile
            Open fichier For Input As #N
 
            i = 0
            k = Range("A100000").End(xlUp).Row
              Do While Not EOF(1)
                   Line Input #N, contenu
                   i = k
                   Cells(i, 1).Value = contenu
                   Cells(i, 2).Value = Mid(fichier, posi_slash, 50)
                   k = k + 1
               Loop
 
               Close #N
        End If
    Next fichier
 
End Sub

en espérant que ça fera bien ce que tu veux

[baillargeois]

Merci beaucoup Jérome. Ça fonctionne très bien. Dans la colonne B, j'ai bien le nom de mon fichier qui apparait sous cette forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs\nom\Desktop\data\fichier1.txt

C'est une belle avancée pour mon projet... Est il par contre possible d'inscrire que le nom du fichier sans le chemin (et si possible sans l'extension.txt) ?

Merci

[jerome.vaussenat]

Salut,

Normalement, j'ai codé pour affiché le nom sans le chemin d'accès au fichier.
En tout cas, chez moi, çà marche.

J'ai modifié pour retirer l’extension

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Dim posi_slash As Integer
 
Sub on_y_va() 'ouvre une boite de dialogue qui permet de sélectionner le dossier où se trouvent les fichiers
    Dim monRepertoire As String
 
    Range("A1:A100000").ClearContents 'supprime tout ce qui est sur la feuille active
    monRepertoire = "C:\Users\jerome\Desktop\coucou"
    posi_slash = Len(monRepertoire) + 2
    aspirer monRepertoire
End Sub
 
Sub aspirer(Repertoire As String) 'importe tous les fichiers les uns à la suite des autres dans la première colonne
 
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim ws As Worksheet, wrecap As Worksheet
    Dim nomcourt As String
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".txt" Then
            N = FreeFile
            Open fichier For Input As #N
 
            i = 0
            k = Range("A100000").End(xlUp).Row
              Do While Not EOF(1)
                   Line Input #N, contenu
                   i = k
                   Cells(i, 1).Value = contenu
                   nomcourt = Mid(fichier, posi_slash, 50)
                   nomcourt = Left(nomcourt, Len(nomcourt) - 4)
                   Cells(i, 2).Value = nomcourt
                   k = k + 1
               Loop
 
               Close #N
        End If
    Next fichier
 
End Sub

dis nous ce qu'il en est.

GG

[baillargeois]

Merci beaucoup ça fonctionne parfaitement !