VBA: Prototype Class than connects to oracle and checks if connection is up. Plus VBA singleton pattern

Here some prototyping code of a class that is able to connect to Oracle through OleDB and to check if the connection is up before doing some application logic. Class name is TUploadHelper.


Private m_conn As Object

Private Function GetConn_() As Object
If m_conn Is Nothing Then
Set m_conn = CreateObject("ADODB.Connection")
End If
Set GetConn_ = m_conn
End Function

Private Function Connected_() As Boolean
Dim recordSet As Object
Dim value As Long
Dim errCode As Variant
Dim errMsg As Variant

If Not PopErrors() Then On Error GoTo L_ERR_HANDLER

value = 0
Connected_ = False

Set recordSet = CreateObject("ADODB.Recordset")

Set recordSet.ActiveConnection = GetConn_()

recordSet.Open "select 1 as value_ from dual"
While Not recordSet.EOF
value = recordSet.Fields(0)
If 1 = value Then
Connected_ = True
GoTo L_CLEANUP
End If
Wend
' не вернулось ни одной записи
L_ERR_HANDLER:
errCode = Err.Number
errMsg = Err.Description
L_CLEANUP:
On Error GoTo 0
If 1 = recordSet.State Then
recordSet.Close
End If
Set recordSet = Nothing
End Function


Private Sub Class_Deinitialize()
If Not m_conn Is Nothing Then
If 1 = m_conn.State Then
m_conn.Close
End If
Set m_conn = Nothing
End If
End Sub

Private Function Authorized_() As Boolean
Authorized_ = False
End Function

Private Sub Connect_()
' Dim state_ As Variant
m_conn.Open "Provider=OraOLEDB.Oracle;Data Source=your_server.world;User ID=your_user;Password=your_pass;PLSQLRSet=1;"
' state_ = m_conn.State
End Sub

Public Sub Ut()
If Not Connected_ Then
Connect_
If Not Connected_ Then
End If
End If
End Sub

And here is module code that implements singleton pattern for TUploadHelper object.


'Singleton pattern
Private g_uploadHelper As TUploadHelper
Public Property Get GetUploadHelper() As TUploadHelper
If g_uploadHelper Is Nothing Then
Set g_uploadHelper = New TUploadHelper
End If
Set GetUploadHelper = g_uploadHelper
End Property

Leave a Reply

Your email address will not be published. Required fields are marked *