Option Explicit

Const ForReading = 1
Const ForWriting = 2


Sub SupprimetTexteEndouble()
    
    'Nécessite d'activer la référence "Microsoft Scripting Run Time"
    
    Dim oDict As Scripting.Dictionary
    Dim oFSO As Scripting.FileSystemObject
    Dim oFile As Scripting.TextStream
    Dim maCle 'As ????????????????
    Dim strName As String, Fichier As String
    
    Fichier = "C:\NomFichier.txt"
    
    
    Set oDict = CreateObject("Scripting.Dictionary")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.OpenTextFile(Fichier, ForReading)
    
    '--- Récupère les données sans doublon ---
    Do Until oFile.AtEndOfStream
        strName = oFile.ReadLine
        If Not oDict.Exists(strName) Then oDict.Add strName, strName
    Loop
    
    oFile.Close
    '-----------------------------------------
    
    
    Set oFile = oFSO.OpenTextFile(Fichier, ForWriting)
    'Retransfère les données sans doublons dans le fichier txt
    For Each maCle In oDict.Keys
        oFile.WriteLine maCle
    Next
    
    oFile.Close
End Sub

Sub Test()
    Dim Fichier As String, Chemin As String
    Dim i As Long
    
    'Répertoire contenant les fichiers
    Chemin = "C:\Documents and Settings\mimi\dossier\general\excel"
    Fichier = Dir(Chemin & "\*.txt")
    
    'Boucle sur les fichiers
    Do While Fichier <> ""
        
        i = Range("A65536").End(xlUp).Row + 1
        ImportText Chemin & "\" & Fichier, Cells(i, 1)
        
        Fichier = Dir
    Loop
End Sub

Sub ImportText(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable
    
    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)
    
    With QT
        'Définit les séparateur de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub

Sub CompilationFichiersTexte_ADO()
'
'Nécessite d'activer la référence
'"Microsoft ActiveX Data Objects 2.x Library"
'
Dim Rc As ADODB.Recordset
Dim cn As String, Chemin As String, Fichier As String, x As String
Dim i As Long
    
'répertoire contenant les fichiers texte
Chemin = "C:\Repertoire"
    
'Ouvre un nouveau fichier Texte pour compiler les données
'! attention à ne pas le placer dans le meme repertoire que les autres fichiers...
Open "C:\Compilation.txt" For Output As #1

'--- Création d'un entête: adaptez cette ligne en fonction du nombre
'de colonnes dans les fichiers (2 colonnes dans cet exemple):
Print #1, "Champ1;Champ2" & vbCrLf;
'------------
        
    'boucle sur l'ensemble des fichiers txt
    Fichier = Dir(Chemin & "\*.txt")
    Do While Fichier <> ""
        
        '----- requète pour récupérer le contenu du fichier txt
        cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
        
        Set Rc = New ADODB.Recordset
        Rc.Open Source:="SELECT * FROM [" & Fichier & "]", ActiveConnection:=cn
        
        If Not Rc.EOF Then
                
                '--- recuperation de la première ligne
                For i = 0 To Rc.Fields.Count - 1
                x = x & Rc.Fields(i).Name & ";"
                Next i
                Print #1, Left(x, Len(x) - 1) & vbCrLf;
                '---
            
            Print #1, Rc.GetString(, , ";", vbCrLf, "");
        End If
        
        Rc.Close
        x = ""
        '-------------------------
    Fichier = Dir
    Loop
    
'Fermeture du fichier Compilation
Close #1

MsgBox "Opération terminée"
End Sub

Sub TriFichierTXT_ADO()
'
'Nécessite d'activer la référence
'"Microsoft ActiveX Data Object 2.x Library'
'
    Dim Rc As ADODB.Recordset
    Dim cn As String, Chemin As String, Fichier As String
    Dim i As Long
    Dim x As String
    
'Ouvre un nouveau fichier Texte pour compiler les données triée
Open "C:\CompilationTriee.txt" For Output As #1
    
    'Le fichier que vous souhaitez trier:
    Chemin = "C:\"
    Fichier = "Compilation.txt"
    
    cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
    "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
    
    Set Rc = New ADODB.Recordset
    Rc.Open Source:="SELECT * FROM " & Fichier & _
                " ORDER BY Champ1", ActiveConnection:=cn
    
    If Not Rc.EOF Then
                
                '--- récupération de la première ligne
                For i = 0 To Rc.Fields.Count - 1
                x = x & Rc.Fields(i).Name & ";"
                Next i
                Print #1, Left(x, Len(x) - 1) & vbCrLf;
                '---
    
    Print #1, Rc.GetString(, , ";", vbCrLf, "");
    End If
    
    Rc.Close
    Set Rc = Nothing

'Fermeture du fichier CompilationTriee
Close #1

MsgBox "Opération terminée"
End Sub