Public Function Get_Fields( _
Target As Variant, _
ByVal Select_String As String, _
Optional ByVal Select_Base As String, _
Optional Header As Boolean = False, _
Optional Column_Widths As String = "-1") As Boolean
Dim Base As Object
Dim Requete As Object
If InStr(1, ThisWorkbook.FullName, "https:", vbTextCompare) Then
Fname = Environ("OneDrive")
T = Split(ThisWorkbook.FullName, "/")
For i = 4 To UBound(T)
Fname = Fname & "\" & T(i)
Next
Else
Fname = ThisWorkbook.FullName
End If
MsgBox "Fname=" & Fname
Sql_Driver = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fname & ";READONLY=FALSE"
If Select_Base = "" Then Select_Base = Sql_Driver
On Error Resume Next
Set Base = CreateObject("ADODB.Connection")
Base.CursorLocation = 3 ' ne pas utiliser adUseClient ou adUseServer sinon renseigner les références vb
Base.Open Select_Base
Set Requete = CreateObject("ADODB.recordset")
Requete.Open Select_String, Base
Select Case True
Case Err <> 0
Get_Fields = False
MsgBox "Erreur " & Err().Number & vbLf & Err().Description
Case Requete.State = 0 ' Fermé <-- Update ou insert ou delete ( pas de retour ) "
Get_Fields = True
Case Requete.RecordCount = 0
Get_Fields = False
Case Else
Get_Fields = True
Select Case TypeName(Target)
Case "ListBox", "ComboBox" ' Retour dans une Listbox
With Target
.Clear
.ColumnCount = Requete.Fields.Count
.ColumnWidths = Column_Widths
.Column = Requete.GetRows
End With
Case "Range" ' une plage de cellules ou tableau excel
If Target.ListObject Is Nothing Then
If Header Then
For i = 0 To Requete.Fields.Count - 1
Cells(Target.Row, Target.Column + i).Value = Requete.Fields(i).Name
Cells(Target.Row, Target.Column + i).Interior.Color = 13553360
Cells(Target.Row, Target.Column + i).Borders.LineStyle = xlDouble
Next
Set Target = Target.Offset(1)
End If
Else
If Not Target.ListObject.DataBodyRange Is Nothing _
Then Target.ListObject.DataBodyRange.Delete
End If
Target.CopyFromRecordset Requete
Case Else ' Retour dans une variable tableau
Target = Requete.GetRows
End Select
End Select
If Requete.State > 0 Then Requete.Close
Set Requete = Nothing
Base.Close
Set Base = Nothing
End Function