Rem /************************************************************************************/
Rem /* FILENAME : clsObjBEDBConnection */
Rem /* TYPE : VBA Class */
Rem /* DESCRIPTION : Class containing DSN-less ADO DB connection object for other */
Rem /* ADO DB objects to utilize */
Rem /* */
Rem /* AUTHOR : Michael D Lueck */
Rem /* mlueck@lueckdatasystems.com */
Rem /* */
Rem /* NEEDS : */
Rem /* */
Rem /* USAGE : */
Rem /* */
Rem /* REVISION HISTORY */
Rem /* */
Rem /* DATE REVISED BY DESCRIPTION OF CHANGE */
Rem /* ---------- ---------- ------------------------------------------------------- */
Rem /* 08/22/2011 MDL Initial Creation */
Rem /* 08/25/2011 MDL Added explicit function return declaration */
Rem /* 11/04/2011 MDL Updated to use getMSysObjectsConnectString call rather than*/
Rem /* reinventing the wheel, added Terminate */
Rem /* 10/24/2012 MDL Updated to make ADODBConnectionObj a class property */
Rem /* 10/24/2012 MDL Insured that return in the On Error of a Property Get which*/
Rem /* returns an Object will return Nothing */
Rem /* 10/24/2012 MDL Correct return object type of ADODBConnectionObj */
Rem /* 10/26/2012 MDL Greatly enhanced the error checking in this class */
Rem /* 11/13/2012 MDL Enhancements to Class Initialization error handling */
Rem /* 12/17/2012 MDL Forced to move to a disposable adoConn obj as Win7 power */
Rem /* save appears to kill it */
Rem /************************************************************************************/
Option Compare Database
Option Explicit
'Attributes
Dim lngFailCount As Long
Dim lngMaxFailCount As Long
Private Sub Class_Initialize()
On Error GoTo Err_Class_Initialize
'Reset the error counters
lngFailCount = 0
'Set Max Fail Count
lngMaxFailCount = 4
Exit_Class_Initialize:
Exit Sub
Err_Class_Initialize:
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Subroutine: Class_Initialize()")
'Disable further error handling. Since the code was already handling an error, if we raised the error without first
'turning it off, that would result in an "Automation Error" aka Double Trap
On Error GoTo 0
'Raise the error to the caller program
Err.Raise Number:=vbObjectError + 1, _
Source:="Class: " & TypeName(Me) & ", Subroutine: Class_Initialize()", _
Description:="Failed to Class_Initialize() class instance"
Resume Exit_Class_Initialize
End Sub
Public Function ADODBConnectionObj() As Object
On Error GoTo Err_ADODBConnectionObj
Dim adoConn As Object
Dim strDBConnectionString As String
'Obtain the correct connection string for ADO type objects
strDBConnectionString = ObjAppSettings.MSysObjectsConnectString()
'Next create a new Connection object
Set adoConn = CreateObject("ADODB.Connection")
'And connect to the BE DB
adoConn.Open strDBConnectionString
'Check the Connection object
If Me.Check(adoConn) = False Then
'Bad connection, so trash the object and return an error
Set adoConn = Nothing
End If
'Return the Connection object
Set ADODBConnectionObj = adoConn
Exit_ADODBConnectionObj:
'Clean up the connection to the database
Set adoConn = Nothing
Exit Function
Err_ADODBConnectionObj:
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: ADODBConnectionObj()")
Set ADODBConnectionObj = Nothing
Resume Exit_ADODBConnectionObj
End Function
Public Function Check(ByRef adoConn As Object) As Boolean
On Error GoTo Err_Check
Dim lngRC As Long
'Check the State of the Connection object
lngRC = adoConn.State
'Process the return code
If lngRC <> adStateOpen Then
Select Case lngRC
Case adStateClosed
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check(), Error: adoConn.State = adStateClosed")
Case adStateConnecting
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check(), Error: adoConn.State = adStateConnecting")
Case adStateExecuting
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check(), Error: adoConn.State = adStateExecuting")
Case adStateFetching
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check(), Error: adoConn.State = adStateFetching")
Case Else
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check(), Error: Unknown adoConn.State = " & lngRC)
End Select
'Bump the Failed Connection Counter +1
Call Me.IncrementFailCount
'Bad return code
Check = False
Else
'Good return code
Check = True
End If
Exit_Check:
Exit Function
Err_Check:
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Function: Check()")
Check = False
Resume Exit_Check
End Function
Public Function FailCount() As Long
FailCount = lngFailCount
End Function
Public Function MaxFailCount() As Long
MaxFailCount = lngMaxFailCount
End Function
Public Sub IncrementFailCount()
On Error GoTo Err_IncrementFailCount
lngFailCount = lngFailCount + 1
'Check if we have reached the MaxFailedCount
If lngFailCount = lngMaxFailCount Then
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Subroutine: IncrementFailCount(), Error: Reached the Max Failed Connection Level of " & Me.MaxFailCount & ". Exiting Fandango FE NOW!")
'Close all of Access... bye bye now bye bye!!
DoCmd.Quit
End If
Exit_IncrementFailCount:
Exit Sub
Err_IncrementFailCount:
Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Subroutine: IncrementFailCount()")
Resume Exit_IncrementFailCount
End Sub
