Attribute VB_Name = "lib_adodb_for_xls"
'-------------------------------------------------------------------------------
'File         : lib_adodb_for_xls.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://http://wiki.yaslaw.info/dokuwiki/doku.php/vba/excel/adodbsql
'Environment  : VBA 2010 +
'Version      : 1.1.0
'Name         : lib_adodb_for_xls
'Author       : Stefan Erb (ERS)
'History      : 27.01.2016 - ERS - Creation
'             : 20.06.2016 - ERS - Vollständig auf LateBinding umgestellt
'-------------------------------------------------------------------------------
Option Explicit

'/**
' * Die Parameter für das ADODB Objekt
' */
Private Enum lateBindingAdodbParameters
    adDate = 7
    adDouble = 5
    adStateOpen = 1
    adCmdText = 1
    adUseClient = 3
    adOpenDynamic = 2
    adLockOptimistic = 3
End Enum

'/**
' * Schreibt ins Excel inkl Header
' * @param  Range   First cell
' * @param  Recordset
' */
Public Sub writeFullData(ByRef ioStartCell As Range, ByRef ioRs As Object)
    writeHeader ioStartCell, ioRs
    ioStartCell.Offset(1).CopyFromRecordset ioRs
End Sub

'/**
' * Write the Header of a adodb.recordset
' * @param  Range   First cell
' * @param  Recordset
' */
Public Sub writeHeader(ByRef ioStartCell As Range, ByRef ioRs As Object)
    Dim colNr As Long
    Dim delta As Long:  delta = ioStartCell.Column

    For colNr = 0 To ioRs.Fields.Count - 1
        ioStartCell.Worksheet.Cells(ioStartCell.Row, colNr + delta).Value = ioRs.Fields(colNr).Name
    Next
End Sub

'/**
' * Handle dhe adodb-connection to the current workbook
' * @param  Boolean FLag, ob die Connectionneu aufgebaut werden soll
' * @return ADODB.Conection
' */
Private Property Get connection(Optional ByVal iReconnect As Boolean) As Object
    Static pConn As Object
    If pConn Is Nothing Or iReconnect Then
        Set pConn = CreateObject("ADODB.Connection")
        pConn.Provider = "Microsoft.Jet.OLEDB.4.0"
        pConn.ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
    End If
    If Not (pConn.State And adStateOpen) = adStateOpen Then
         pConn.Open
    End If
    Set connection = pConn
End Property

'/**
' * Open a adodb recordset from the current workbook
' * @param  String      SQL-String
' * @param  Boolean FLag, ob die Connectionneu aufgebaut werden soll
' * @return ADODB.Recordset
' */
Public Function openRs(ByVal iSql As String, Optional ByVal iReconnect As Boolean) As Object
    Dim rst As Object: Set rst = CreateObject("ADODB.Recordset")
    Dim cmd As Object: Set cmd = CreateObject("ADODB.Command")

    Set cmd.ActiveConnection = connection(iReconnect)
    cmd.CommandType = adCmdText
    cmd.CommandText = iSql

    rst.CursorLocation = adUseClient
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic

    'open the connection
    rst.Open cmd

    'disconnect the recordset
    Set rst.ActiveConnection = Nothing

    'cleanup
    If cmd.State = adStateOpen Then
        Set cmd = Nothing
    End If
    Set openRs = rst
End Function