Option Explicit


' ***********************************************************************
' *****                                                             *****
' *****        CODE PierreP56 : http://tatiak.canalblog.com/        *****
' *****                                                             *****
' ***********************************************************************


Public Cnx As Object, Rst As Object


Sub Connect_Access(Accdb As String)
    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Provider = "MSDASQL"
    Cnx.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Accdb & ";"
    Set Rst = CreateObject("ADODB.Recordset")
End Sub


Function Select_Db(Req As String) As Variant
Dim T As Variant, Rcd As Variant
Dim lig As Long, col As Long, i As Long, j As Long

    On Error GoTo errhdlr
    ReDim Rcd(1 To 1, 1 To 1)
    Rst.Open Req, Cnx, 3
    lig = Rst.RecordCount
    If lig > 0 Then
        Rst.MoveFirst
        T = Rst.GetRows
        col = Rst.Fields.Count
        ReDim Rcd(1 To lig + 1, 1 To col)
        For j = 0 To col - 1
            Rcd(1, j + 1) = Rst.Fields(j).Name
            For i = 0 To lig - 1
                Rcd(i + 2, j + 1) = IIf(IsNull(T(j, i)), "", T(j, i))
            Next i
        Next j
    End If
    Select_db = Rcd
    Exit Function
    
errhdlr:
    Rcd(1, 1) = "Erreur n°" & Err.Number & vbCrLf & Err.Description
    Select_db = Rcd
End Function


Sub Close_Cnx(Optional x As Byte)
    On Error Resume Next
    If x > 0 Then Rst.Close
    Cnx.Close
    Set Cnx = Nothing
    Set Rst = Nothing
End Sub