XL 2016 Requête SQL sur un fichier Excel

Sub Test()
Dim Cn As String, TBL() As String
Cn = GenereCSTRING(Xls, Base:="C:\Fichier.xlsx", Titre:=True)
TBL() = ListeTables(Cn)
ActiveCell.CopyFromRecordset ExecuteRequete("SELECT * FROM [" & TBL(0) & "]", Cn)
End Sub

'                    dysorthographie ©
'**************************************************************************************
Public Enum separateur
    Tabulation = 0
    Virgule = 1
    PoinVirgule = 2
    Pip = 3
    Fixe = 4
End Enum
Public Enum TypeCsv
    Bit = 0         ' "Bit"
    Bool = 1        ' "Boolean"
    Bytes = 2       ' "Byte"
    Short = 3       ' "Short"
    Entier = 4      ' "Integer"
    EntierLong = 5  ' "Long"
    Signer = 6      ' "Single"
    numerique = 7   ' "Double"
    Reel = 8        ' "Float"
    Date = 9        ' "DateTime"
    Text = 10       ' "Text"
    car = 11        ' "Char"
    txt = 12        ' "Memo"
    LonTXT = 14     ' "LongChar"
End Enum

' Permet de définir quel connecteur ODBC uilise pour la connexion à la base de données !
Public Enum MyConst
    ACCESS
    ODBC
    ORACLE
    SQLSERVER2005
    SQLServer2008R2
    SQLITE
    SQLite3
    CSV
    Xls
    MySQL
    DBF
End Enum
'**************************************************************************************
'Permet de définir le type de champs
Public Enum AdodbTypeChamps
   adEmpty = 0
    adSmallInt = 2
    adInteger = 3
    adSingle = 4
    adDouble = 5
    adCurrency = 6
    adDate = 7
    adBSTR = 8
    adIDispatch = 9
    adError = 10
    adBoolean = 11
    adVariant = 12
    adIUnknown = 13
    adDecimal = 14
    adTinyInt = 16
    adUnsignedTinyInt = 17
    adUnsignedSmallInt = 18
    adUnsignedInt = 19
    adBigInt = 20
    adUnsignedBigInt = 21
    adFileTime = 64
    adGUID = 72
    adBinary = 128
    adChar = 129
    adWChar = 130
    adNumeric = 131
    adUserDefined = 132
    adDBDate = 133
    adDBTime = 134
    adDBTimeStamp = 135
    adChapter = 136
    adPropVariant = 138
    adVarNumeric = 139
    adVarChar = 200
    adLongVarChar = 201
    adVarWChar = 202
    adLongVarWChar = 203
    adVarBinary = 204
    adLongVarBinary = 205
End Enum

Public Enum CharacterSet
    ANSI = 0    'ANSI
    UTF = 1     'UTF-8
End Enum
'***************************************************************************************
'Permet de sauvegarder le Nom ainsi que  le type d'un champs
Public Type Champ
    Name As String
    TypeChamp As AdodbTypeChamps
End Type
'******************************************************************************************************************************************
'Retourne le ConetionString pour une connexion à une base de données ! _
Données d'entrées, information optionnel ! _
User : utilisateur  {Login] _
Server : Répertoire et/ou nom du serveur {SQL server, Oracle, MySQL, CSV} _
Password  mot de passe si nécessaires  {Login} _
Base : Non dela base de données et/on chemein complet {SQL server, Oracle, MySQL, EXCEL, Sqlite} _
Titre : défini si le nom des champs figure sur la première ligne du document {MySQL, EXCEL }
'******************************************************************************************************************************************
Public Function GenereCSTRING(TYPEBASE As MyConst, _
Optional User As String, _
Optional Server As String, _
Optional Password As String, _
Optional Base As String, _
Optional Titre As Boolean = False, _
Optional IMEX As Boolean = True)
'Permet de générer le Cornec String
'    ACCESS97
'    ACCESS2000
'    ACCESS2012
'    ODBC
'    ORACLE
'    SQLSERVER2005
'    SQLServer2008R2
'    SQLITE
'    SQLite3
'    CSV
'    Xls
'    MySQL

Select Case TYPEBASE
     Case Xls
            GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Base & ";Extended Properties=""Excel 12.0;HDR=" & Array("No", "YES")(Abs(Titre)) & ";IMEX=" & Abs(IMEX) & ";"""
    Case ACCESS2012
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Base & ";Jet OLEDB:Database Password=" & Password & ";"
    Case MySQL
    GenereCSTRING = " DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & Server & ";UID=" & User & ";DATABASE=" & Base & ";Password=" & Password
    Case ODBC
        GenereCSTRING = "Provider=MSDASQL.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & Base
    Case ORACLE
        GenereCSTRING = "Provider=OraOLEDB.Oracle.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & Base
    Case SQLSERVER2005
        GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    Case SQLServer2008R2
        GenereCSTRING = "Provider=SQLNCLI;Server=" & Server & ";Database=" & Base & ";UID=" & User & ";PWD=" & Password & ";"
    Case SQLITE
        GenereCSTRING = "Provider=OleSQLite.SQLiteSource.3; Data Source=" & Fichier
        GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & Fichier & ";StepAPI=;Timeout="
    Case SQLite3
        GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & Base & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
    Case CSV
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server & ";Extended Properties=""Text;HDR=" & Array("No", "YES")(Abs(Titre)) & ";FMT=Delimited;"""
    Case DBF
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server & ";Extended Properties=dBASE IV;User ID=" & User & ";"
    Case Else
        GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
End Select
End Function
'******************************************************************************************************************************************
'Ici nous avons un requêter universel ! _
Il permet  d'exécuter et/ou retourne une requête SQL {Exécution Direct Insert, Update, Delete ou de sélection} _
Paramètres : _
Sql : requête à exécuter _
 cn : connectionSting _
 Param() : paramètres de la requête par coupe de 2 _
Exeple:  setMyRequête = ExecuteRequete(" Select * From MyTable where Champ1= ? ", " Champ1 ", "Valeure ")
'******************************************************************************************************************************************
Function ExecuteRequete(Sql As String, Cn As String, ParamArray Param() As Variant) As Object
Dim I As Integer
With CreateObject("ADODB.Command")
    .ActiveConnection = Cn
    .CommandType = 1
    .CommandTimeout = 500
     .CommandText = Sql
    For I = LBound(Param) To UBound(Param) Step 2
        Set prm = CreateObject("ADODB.Parameter")
        prm.Name = Param(I): prm.Value = Param(I + 1): prm.Type = 12
        .Parameters.Append prm
    Next
 
    Set ExecuteRequete = .Execute
End With
End Function
'******************************************************************************************************************************************
'Retourne la liste des tables de la base de données. _
Paramètre  Connexion : ConectionString
'******************************************************************************************************************************************
Public Function ListeTables(Connexion As String) As String()
Dim TBL() As String, I As Integer
With CreateObject("ADOX.Catalog")
    .ActiveConnection = Connexion
    For Each T In .Tables
        ReDim Preserve TBL(I)
        TBL(I) = T.Name
        I = I + 1
    Next
End With
    ListeTables = TBL
End Function
'******************************************************************************************************************************************
'Retourne la des champs d'une table de la base de données. _
Paramètre  Connexion : ConectionString _
          Table : Nomde la table
'******************************************************************************************************************************************
Public Function LiteChamps(Connexion As String, Table As String) As Champ()
Dim Ch() As Champ, I As Integer
With CreateObject("ADOX.Catalog")
    .ActiveConnection = Connexion
    For Each T In .Tables(Table).Columns
        ReDim Preserve Ch(I)
        Ch(I).Name = T.Name
        Ch(I).TypeChamp = T.Type
        I = I + 1
    Next
End With
LiteChamps = Ch
End Function
'******************************************************************************************************************************************

Public Sub ShemaIn(Fichier As String, _
                    Server As String, _
                    FichertVierge As Boolean, _
                    Kill As Boolean, _
                    Delimited As separateur, _
                    Character As CharacterSet, _
                    ColNameHeader As Boolean, _
                    DateTimeFormat As String, _
                    DecimalSymbol As String, _
                    ParamArray Champ() As Variant)
Dim txt As String, DLM, Tp
Tp = Array("Bit", "Boolean", "Byte", "Short", "Integer", "Long", "Single", "Double", "Float", "DateTime", "Text", "Char", "Memo", "LongChar")
DLM = Array("TabDelimited", "CSVDelimited", "Delimited(;)", "Delimited(|)", "FixedLength")
txt = "[" & Fichier & "]" & vbCrLf & "Format= " & DLM(Delimited) & vbCrLf & _
        "CharacterSet=" & Array("ANSI", "UTF-8")(Character) & vbCrLf & _
        "ColNameHeader=" & Array("False", "True")(Abs(ColNameHeader)) & vbCrLf & _
        "DateTimeFormat=" & DateTimeFormat & vbCrLf & _
         "DecimalSymbol=" & Chr(34) & DecimalSymbol & Chr(34) & vbCrLf
 
        For Each F In Champ
            For I = LBound(F, 1) To UBound(F, 1)
            txt = txt & F(I, 1) & "=" & F(I, 2) & " " & Tp(F(I, 3)) & " Width " & F(I, 4) & vbCrLf
            Next
        Next
With CreateObject("Scripting.FileSystemObject")
    With .OpenTextFile(Server & "\schema.ini", IIf(Kill, 2, 8), True)
        .Write txt
        .Close
    End With
    If FichertVierge Then
        With .OpenTextFile(Server & "\" & Fichier, 2, True)
            .Close
        End With
    End If
End With
End Sub