Microsoft 365 Recordset avec fichier TSV

    With Cn
        '.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Lst & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
        '.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Lst & ";Extended Properties=""Text;HDR=YES;IMEX=2;FMT=Delimited""", Path.GetDirectoryName(Lst)
        '.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Lst & ";Extended Properties=""text;FMT=Delimited(" & vbTab & ");"
        .Open "Provider=Microsoft.Jet.Oledb.4.0;" & "Data Source = " & Lst & ";" & "Extended Properties='text; " & "HDR=Yes;" & "FMT=TAB' "
      
    End With

.Open "Provider=Microsoft.Jet.Oledb.4.0;" & "Data Source = " & Lst & ";" & "Extended Properties='text; " & "HDR=Yes;" & " [B]FMT=TabDelimiter[/B] ' "

Dim cnx As Object, rst As Object
Set cnx = CreateObject("adodb.connection")
cnx.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=""text;FMT=TabDelimited;HDR=YES"";"
Set rst = CreateObject("adodb.recordset")
rst.Open "SELECT * FROM [table.csv];", cnx
Feuil2.Range("A1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnx.Close
Set cnx = Nothing

titre    truc    chose    blabla
1    2    3    4
5    6    7    8
9    10    11    12

[table.csv]
ColNameHeader=True
Format=TABDelimited
Col1="titre" Text
Col2="truc" Double
Col3="chose" Double
col4="blabla" text

Sub Import_Tabbed_File()
    Cells.Clear
    File = ' nom complet du fichier avec son dossier
    With ActiveSheet.QueryTables.Add( _
        Connection:="TEXT;" & File, Destination:=Range("$A$1"))
        .SaveData = False
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileTabDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

 Function Import_data(Lst)
    Dim wbk As Workbook

    Application.ScreenUpdating = False
    
    'Changement d'extension
    sourc = Lst: destination = Left(sourc, Len(sourc) - 3) & "txt"

    'Copie du fichier en changeant l'extension
    FileCopy sourc, destination
    
    'Ouverture du fichier
    Workbooks.OpenText Filename:=destination, _
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))
    
    Set wbk = ActiveWorkbook
    'Mise en mémoire des données
    Import_data = wbk.ActiveSheet.UsedRange
    wbk.Close
    'Destruction du fichier tampon
    Kill destination
    Application.ScreenUpdating = True
    
    
    Set wbk = Nothing
        
End Function

Function Select_File_Or_Files_Mac()
        Dim MyPath As String
        Dim MyScript As String
        Dim MyFiles As String
        Dim MySplit As Variant
        Dim N As Long
        Dim Fname As String
        Dim mybook As Workbook

        On Error Resume Next
        MyPath = MacScript("return (path to documents folder) as String")
        'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

        ' In the following statement, change true to false in the line "multiple
        ' selections allowed true" if you do not want to be able to select more
        ' than one file. Additionally, if you want to filter for multiple files, change
        ' {""com.microsoft.Excel.xls""} to
        ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
        ' if you want to filter on xls and csv files, for example.
        MyScript = _
        "set applescript's text item delimiters to "","" " & vbNewLine & _
                   "set theFiles to (choose file of type " & _
                 " {""com.microsoft.Excel.xls""} " & _
                   "with prompt ""KPAM: Selectionner un fichier"" default location alias """ & _
                   MyPath & """ multiple selections allowed false) as string" & vbNewLine & _
                   "set applescript's text item delimiters to """" " & vbNewLine & _
                   "return theFiles"

        MyFiles = MacScript(MyScript)
        On Error GoTo 0

        If MyFiles <> "" Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With

            MySplit = Split(MyFiles, ",")
            For N = LBound(MySplit) To UBound(MySplit)

                ' Get the file name only and test to see if it is open.
                Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
                If bIsBookOpen(Fname) = False Then

                    Set mybook = Nothing

                Else
                    MsgBox "Fermer le fichier : " & MySplit(N) & " avant de lancer l'analyse."
                    Select_File_Or_Files_Mac = Nothing: Exit Function
                End If
                Select_File_Or_Files_Mac = MySplit(N)
                
            Next N
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        End If
    End Function

    Function bIsBookOpen(ByRef szBookName As String) As Boolean
    ' Contributed by Rob Bovey
        On Error Resume Next
        bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
    End Function
    
Function Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Workbooks(ActiveWorkbook.Name).Path

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel 97-2003 Files  (*.tsv), *.tsv,(*.xls), *.xls", _
            Title:="KPAM: Selectionner un fichier", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing

            Else
                MsgBox "Fermer le fichier : " & Fname(N) & " avant de lancer l'analyse."
                Select_File_Or_Files_Windows = Nothing
            End If
            
            Select_File_Or_Files_Windows = Fname(N)
            
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    
End Function

Sub Chargement_Fichier()
    Dim ws_Formulaire As Worksheet
    Dim val_app&, Nom_fichier As String
    Dim Split_fichier
    Dim Lst()
    
    Set ws_tracker = Sheets("Tracker")
    
    'Liste des fichiers disponible à l'analyse
    Lst = Array("A", "B", "C", "D", "E", _
        "F", "G", "H", "I")
    
    ' Test for the operating system.
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' Windows
        FichierAOuvrir = Select_File_Or_Files_Windows
    Else
        ' MAC
        If val(Application.Version) > 14 Then
            FichierAOuvrir = Select_File_Or_Files_Mac
        End If
    End If
    
    val_app = CInt(Right(Application.Caller, Len(Application.Caller) - 9))
    
    'Alimentation des enregistrements
    With ws_tracker
        .Unprotect
        If FichierAOuvrir <> False Then
            Split_fichier = Split(Dir(FichierAOuvrir), ".")
            rec(val_app) = Import_data(FichierAOuvrir)
            .Shapes.Range(Array("Tick" & val_app)).Visible = True
            .Shapes(Application.Caller).TextFrame.Characters.Text = Split_fichier(0)
            .Columns(3).AutoFit
        Else
            .Shapes.Range(Array("Tick" & val_app)).Visible = False
            Select Case val_app
                Case 10, 18, 22
                    .Shapes(Application.Caller).TextFrame.Characters.Text = "Obligatoire"
                Case Else
                    .Shapes(Application.Caller).TextFrame.Characters.Text = "Optionnel"
            End Select
            
            .Columns(3).AutoFit
        End If
        .Protect
    End With
    
    Call Verification(ws_tracker)
    Set ws_Formulaire = Nothing
End Sub

Sub test()
Dim Cn As Object, TB() As String
Set Cn = CreateObject("ADODB.Connection")
Const Path As String = "C:\Test"
With Cn
    .Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source = " & Path & ";Extended Properties='text;HDR=Yes;FMT=TabDelimited'; "
    TB = TableToutes(Cn)   
    For Each F In TB
        ShemaIni Path, CStr(F), "TabDelimited"
        Sheets("Test").Cells(Sheets("Test").Rows.Count, "A").End(xlUp).Offset(1).CopyFromRecordset .Execute("Select * from [" & F & "]")
    Next
.close
End With
Set Cn = Nothing
End Sub
Function TableToutes(Connexion As Object) As String()
Dim t() As String, i As Integer
With Connexion.OpenSchema(20)
    While Not .EOF
        ReDim Preserve t(i)
        t(i) = !TABLE_NAME
        i = i + 1
        .MoveNext
    Wend
    TableToutes = t
End With
End Function

Public Sub ShemaIni(Rep As String, fichier As String, Delimited As String, Optional Champs As String = "", Optional NewCsv As Boolean = False)
Dim txt As String
txt = "[" & Replace(fichier, "#", ".") & "]" & vbCrLf & "Format=" & Delimited
If Champs <> "" Then txt = txt & vbCrLf & Champs
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Rep & "\schema.ini", 2, True)
NewFichier.Write txt
NewFichier.Close
If NewCsv = True Then
    Set NewFichier = fso.OpenTextFile(Rep & "\" & Replace(fichier, "#", "."), 2, True)
    NewFichier.Write ""
    NewFichier.Close


End If
Set NewFichier = Nothing
Set fso = Nothing
End Sub