VB icon

ACCESS / ORACLE ADO Connection and Recordset

Email
Submitted on: 1/5/2015 9:21:00 AM
By: Herman Ibrahim (from psc cd)  
Level: Intermediate
User Rating: By 14 Users
Compatibility: VB 5.0, VB 6.0
Views: 3870
 
     To Provide a Recordset Template (view,execute,edit,Add new) To Provide a Database Connection Template (ORACLE and MS Access)
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :ACCESS / ORACLE ADO Connection and Recordset
'**************************************
-
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: ACCESS / ORACLE ADO Connection and Recordset
' Description:To Provide a Recordset Template 
(view,execute,edit,Add new)
To Provide a Database Connection Template (ORACLE 
and MS Access)
' By: Herman Ibrahim (from psc cd)
'
' Assumes:Add Microsoft ActiveX Data Object 2.X library
into Project Reference.
'**************************************

'Put This part in a module
'======================================
'Starrt of Module
'======================================
Option Explicit
Public Enum RSMethod
 VIEW_RECORD = 0
 EDIT_RECORD = 1
 EXEC_SQL = 2
 NEW_RECORD = 3
End Enum
Function dbConnection(strDatabaseType As String, strDBService As String, Optional strUserID As String, Optional strPassword As String) As ADODB.Connection
 
 Dim objDB As New ADODB.Connection
 Dim strConnectionString As String
 
 If strDatabaseType = "ORACLE" Then
 'Define ORACLE database connection string
 strConnectionString = "Driver={Microsoft ODBC Driver for Oracle};ConnectString=" & strDBService & ";UID=" & strUserID & ";PWD=" & strPassword & ";"
 ElseIf strDatabaseType = "MSACCESS" Then
 'Define Microsoft Access database connection string
 strConnectionString = "DBQ=" & strDBService
 strConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & strConnectionString
 End If
 
 With objDB
 .Mode = adModeReadWrite ' connection mode ???
 .ConnectionTimeout = 10 'Indicates how long to wait while establishing a connection before terminating the attempt and generating an error.
 .CommandTimeout = 5 ' seconds given to execute any command
 .CursorLocation = adUseClient ' use the appropriate cursor ???
 .Open strConnectionString 'open the database connection
 
 End With
 
 Set dbConnection = objDB
End Function
Function CreateRecordSet(ByRef dbConn As ADODB.Connection, ByRef rs As ADODB.Recordset, ByVal method As RSMethod, Optional strSQL As String, Optional TableName As String) As ADODB.Recordset
' close the recordset first if it's open...
' otherwise an error will occured
'(open a recordset which is already opened...)
if rs.State=1 then
rs.close 
end if
 Select Case method
 Case RSMethod.NEW_RECORD
 rs.ActiveConnection = dbConn
 rs.CursorType = adOpenKeyset
 rs.LockType = adLockOptimistic
 rs.CursorLocation = adUseServer
 rs.Open TableName
 
 Case RSMethod.EDIT_RECORD
 rs.ActiveConnection = dbConn
 rs.Source = strSQL
 rs.CursorType = adOpenKeyset
 rs.LockType = adLockOptimistic
 rs.CursorLocation = adUseClient
 rs.Open
' Debug.Print "SQL Statement in EDIT Mode (Createrecordset) : " & strSQL
' Debug.Print "Found " & rs.RecordCount & " records"
 
 Case RSMethod.VIEW_RECORD
 
 rs.ActiveConnection = dbConn 'dbConnection 'dbConn
 rs.Source = strSQL
 rs.CursorType = adOpenForwardOnly
 rs.CursorLocation = adUseClient
 rs.Open
' Debug.Print "Found " & rs.RecordCount & " records"
 rs.ActiveConnection = Nothing
 
 Case RSMethod.EXEC_SQL
 Set rs = dbConn.Execute(strSQL)
 End Select
 Set CreateRecordSet = rs
End Function
'======================================
'End Of Module
'======================================
'=================================================
'======================================
'Sample of subroutines...
'======================================
Sub Add_New_Record()
 Dim objRecSet As New ADODB.Recordset
 Dim objConn As New ADODB.Connection
 Dim strUserID As String
 Dim strPassword As String
 Dim strTableName As String
 Dim strDBType As String
 Dim strDBName As String
 
 strTableName = "YOURTABLE"
 strPassword = "YourPassword"
 strUserID = "YourUserID"
 
 If strDBType = "MSACCESS" Then
 ' strDBName is your Database Name
 strDBName = App.Path & "\YourAccessDB.mdb"
 
 ElseIf strDBType = "ORACLE" Then
 ' strDBName is your Oracle Service Name
 strDBName = "YOUR_ORACLE_SERVICE_NAME"
 strTableName = strUserID & "." & strTableName
 'Table name format ::> USERID.TABLENAME
 Else
 MsgBox "Database is other than ORACLE or Microsoft"
 Exit Sub
 End If
 
 Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
 'send NEW_RECORD and strTableName as a part of parameters
 Set objRecSet = CreateRecordSet(objConn, objRecSet, NEW_RECORD, , strTableName)
 
 objConn.BeginTrans
 With objRecSet
 .AddNew
 .Fields("FIELD1").Value = "your value1"
 .Fields("FIELD2").Value = "your value2"
 .Fields("FIELD3").Value = "your value3"
 .Fields("FIELD4").Value = "your value4"
 .Fields("FIELD5").Value = "your value5"
 .Update
 End With
 If objConn.Errors.Count = 0 Then
 objConn.CommitTrans
 Else
 objConn.RollbackTrans
 End If
 
 objRecSet.Close
 objConn.Close
 Set objRecSet = Nothing
 Set objConn = Nothing
End Sub
Sub View_Record_Only()
 Dim strSQL As String
 Dim strDBName As String
 Dim strDBType As String
 Dim strUserID As String
 Dim strPassword As String
 
 Dim objRecSet As New ADODB.Recordset
 Dim objConn As New ADODB.Connection
 
 If strDBType = "MSACCESS" Then
 ' strDBName is your Database Name
 strDBName = App.Path & "\YourAccessDB.mdb"
 
 ElseIf strDBType = "ORACLE" Then
 ' strDBName is your Oracle Service Name
 strDBName = "YOUR_ORACLE_SERVICE_NAME"
 
 Else
 MsgBox "Database is other than ORACLE or Microsoft"
 Exit Sub
 End If
 
 strPassword = "YourPassword"
 strUserID = "YourUserID"
 strSQL = "SELECT * from USER_TABLE"
 
 Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
 'create a disconnected recordset
 Set objRecSet = CreateRecordSet(objConn, objRecSet, VIEW_RECORD, strSQL)
 objConn.Close
 Set objConn = Nothing
 'manipulate the recordset here.....
 'manipulate the recordset here.....
 'manipulate the recordset here.....
 objRecSet.Close
 Set objRecSet = Nothing
End Sub
Sub Edit_Existing_Record()
 Dim objRecSet As New ADODB.Recordset
 Dim objConn As New ADODB.Connection
 Dim strUserID As String
 Dim strPassword As String
 Dim strSQL As String
 Dim strDBType As String
 Dim strDBName As String
 
 strTableName = "YOURTABLE"
 strPassword = "YourPassword"
 strUserID = "YourUserID"
 
 If strDBType = "MSACCESS" Then
 ' strDBName is your Database Name
 strDBName = App.Path & "\YourAccessDB.mdb"
 
 ElseIf strDBType = "ORACLE" Then
 ' strDBName is your Oracle Service Name
 strDBName = "YOUR_ORACLE_SERVICE_NAME"
 Else
 MsgBox "Database is other than ORACLE or Microsoft"
 Exit Sub
 End If
 strSQL = "Select * from YOUR_TABLE"
 Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
 'send EDIT_RECORD and strSQL as a part of parameters
 Set objRecSet = CreateRecordSet(objConn, objRecSet, EDIT_RECORD, strSQL)
 
 With objRecSet
 .Fields("FIELD1").Value = "your value1"
 .Update
 End With
 objRecSet.Close
 objConn.Close
 Set objRecSet = Nothing
 Set objConn = Nothing
End Sub
'======================================
'End of Sample of subroutines...
'======================================


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.