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 |