Option Explicit
Private strUser As String
Private strProvider As String
Private strPath As String
Private strProperties As String
Private strSQL As String
Private strPassword As String
Private con As ADODB.Connection
Property Let ConnProvider(strCPR As String)

strProvider = strCPR

End Property
Property Let ConnPath(strCPA As String)

strPath = strCPA

End Property
Property Let ConnProperties(strCPP As String)

strProperties = strCPP

End Property
Property Let SQLString(strSQLQuery As String)

strSQL = strSQLQuery

End Property
Property Let SQLPassword(strSQLPassword As String)

strPassword = strSQLPassword

End Property
Public Property Get RecordsetADODB(strSQL As String) As ADODB.Recordset

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open strSQL, con, adOpenStatic, adLockReadOnly

Set RecordsetADODB = rst

End Property
Public Property Get RecordsetArray(strSQL As String) As Variant

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open strSQL, con, adOpenStatic, adLockReadOnly

RecordsetArray = rst.GetRows

End Property
Public Property Get ListSheets() As Variant

Dim i As Integer
Dim rst As ADODB.Recordset
Dim intColumnCount As Integer
Dim strColumnName As String
Dim varItems As Variant

Set rst = con.OpenSchema(adSchemaTables)
intColumnCount = rst.RecordCount
ReDim varItems(0)

For i = 1 To intColumnCount

    ReDim Preserve varItems(1 To UBound(varItems) + 1)
    varItems(UBound(varItems)) = rst.Fields("TABLE_NAME").Value
    rst.MoveNext

Next i

ListSheets = varItems

End Property
Public Property Get ListFields(strTableName As String) As Variant

Dim i As Integer
Dim rst As ADODB.Recordset
Dim intColumnCount As Integer
Dim varItems As Variant

Set rst = con.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTableName, Empty))
intColumnCount = rst.RecordCount
ReDim varItems(0)

For i = 1 To intColumnCount

    ReDim Preserve varItems(1 To UBound(varItems) + 1)
    varItems(UBound(varItems)) = rst.Fields("COLUMN_NAME").Value
    rst.MoveNext

Next i

ListFields = varItems

End Property
Property Set ConnAddProperties(cn As ADODB.Connection)

On Error Resume Next
With cn

    .Provider = strProvider
    .ConnectionString = "Data Source=" & strPath & "; Extended Properties='" & strProperties & "'"
    .CursorLocation = adUseClient

End With
On Error GoTo 0

If Err.Number = 0 Then
    Set con = cn
Else
    MsgBox "Connection properties were not added.", vbCritical + vbOKOnly, "Error"
End If
Err.Clear

End Property
Sub ConnOpen()

On Error Resume Next
con.Open
On Error GoTo 0

If Err.Number <> 0 Then
    MsgBox "Connection was not created.", vbCritical + vbOKOnly, "Error"
End If
Err.Clear

End Sub
Sub ConnClose()

con.Close

End Sub
Sub ConnSet()

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection

If strProvider = "" Or strPath = "" Or strProperties = "" Then
    MsgBox "Connection parameters were not provided."
    Exit Sub
Else
    Set Me.ConnAddProperties = cn
End If

End Sub
Private Sub Class_Initialize()

strUser = Environ("username")

End Sub
Private Sub Class_Terminate()

If Not con Is Nothing Then

    Call ConnClose
    Set con = Nothing

End If

End Sub