ConnectOracle




Public conODBC As Connection
Private rstODBC As Recordset
Private wspODBC As Workspace
Private booODBCDConnected As Boolean
Private booODBCDHaveData As Boolean
Public Event DataEvents(ByVal odEvent As String)

Private Sub Class_Initialize()

RDOConnectString = "ODBC;UID=[enter uid here];PWD=[enter pwd
here];DRIVER={Microsoft ODBC Driver for Oracle};CONNECTSTRING=[enter
sql*net connect string here]"
booODBCDConnected = False
booODBCDHaveData = False
End Sub

Public Function OpenODBCDirectConnection() As Boolean

booODBCDConnected = False
On Error GoTo errH
' 'Create the ODBC-Direct workspace with default UID and PWD

Set wspODBC = CreateWorkspace("", "", "", dbUseODBC)
wspODBC.DefaultCursorDriver = dbUseServerCursor
RaiseEvent DataEvents("Opening Connection...")
' 'Allow the event to be handled by the class instantiator


DoEvents
' 'Open the connection

Set conODBC = wspODBC.OpenConnection("NewConnection", dbDriverComplete,
True, DAOConnectString)
booODBCDConnected = True
OpenODBCDirectConnection = True
Exit Function
errH:
MsgBox Err.Number & ": " & Err.Description
Err.Clear
OpenODBCDirectConnection = False
End Function


Public Sub KillStillExecuting()


If (booODBCDHaveData = False) Then
rstODBC.Cancel
End If

End Sub

Public Function OpenODBCDirectRecordset(ByVal SqlStatement As String) As Recordset

booODBCDHaveData = False
On Error GoTo errH
If (booODBCDConnected True) Then
If (OpenODBCDirectConnection = False) Then 'Function returns false
if an error occurs
Exit Function
End If
End If

RaiseEvent DataEvents("Executing Query...")
Set rstODBC = conODBC.OpenRecordset(SqlStatement, dbOpenSnapshot,
dbRunAsync + dbExecDirect, dbReadOnly)

While (rstODBC.StillExecuting = True)
DoEvents
Wend

RaiseEvent DataEvents("Returning Data...")
rstODBC.MoveLast dbRunAsync

While (rstODBC.StillExecuting = True)
DoEvents
Wend

If (rstODBC.RecordCount = -1) Then
RaiseEvent DataEvents("Determining Record Count...")
rstODBC.MoveFirst
Count = 1
Do
rstODBC.MoveNext
Count = Count + 1
Loop Until rstODBC.EOF
' 'rstODBC.RecordCount = Count

rstODBC.MoveFirst
End If

Set OpenODBCDirectRecordset = rstODBC.Clone
RaiseEvent DataEvents("Ready")
booODBCDHaveData = True
Exit Function
errH:

'Determine if the Cancel method has been invoked. Using the method

'this particular error (since the code tries to use the

'object that would have been created) therefore, this will clear the

'error, raise the DataEvents event (to change the message to "Ready"

'and exit the function without raising an error message.


If (Err.Description = "Object invalid or no longer set.") Then
Err.Clear
RaiseEvent DataEvents("Ready")
Exit Function
End If

MsgBox Err.Number & ": " & Err.Description
Err.Clear

End Function











( connectoracle.html )- by Paolo Puglisi - Modifica del 17/12/2023