vb---ACCESS / orACLE ADO连接示例

wyh1983

程序代码

'**************************************
'模块描述 :ACCESS / orACLE ADO 连接和记录集操作
'**************************************
'提示:要引用 Microsoft ActiveX Data Object 2.X 对象库
'**************************************

'======================================
'模块开始
'======================================
Option Explicit


Public Enum RSMethod
    VIEW_RECORD = 0
    EDIT_RECORD = 1
    EXEC_SQL = 2
    NEW_RECORD = 3
End Enum


'dbConnection函数
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
        '定义ORACLE数据库连接字符串
        strConnectionString = "Driver={Microsoft ODBC Driver for oracle};ConnectString=" & strDBService & ";UID=" & strUserID & ";PWD=" & strPassword & ";"
    ElseIf strDatabaseType = "MSACCESS" Then
        '定义Access数据库连接字符串
        strConnectionString = "DBQ=" & strDBService
        strConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & strConnectionString
    End If
   


    With objDB
        .Mode = adModeReadWrite ' 连接模式
        .ConnectionTimeout = 10
        .CommandTimeout = 5
        .CursorLocation = adUseClient
        .Open strConnectionString
        
    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

    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 Mod
        '     e (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
'======================================
'模块结束
'======================================


'以下是示例部分
'======================================
'增加记录
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 字符串是你的数据库名称
        strDBName = App.Path & "\YourAccessDB.mdb"
        
    ElseIf strDBType = "ORACLE" Then
        ' strDBName 字符串是Oracle 服务器名称
        strDBName = "YOUR_ORACLE_SERVICE_NAME"
        strTableName = strUserID & "." & strTableName
    Else
        MsgBox "数据库不符合ORACLE 或者 Microsoft"
        Exit Sub
    End If
   
    Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
    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 = App.Path & "\YourAccessDB.mdb"
        
    ElseIf strDBType = "ORACLE" Then
        strDBName = "YOUR_ORACLE_SERVICE_NAME"
        
    Else
        MsgBox "数据库不符合ORACLE 或者 Microsoft"
        Exit Sub
    End If
   
    strPassword = "YourPassword"
    strUserID = "YourUserID"
    strSQL = "Select * from USER_TABLE"
   
    Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
    Set objRecSet = CreateRecordSet(objConn, objRecSet, VIEW_RECORD, strSQL)
    objConn.Close
    Set objConn = Nothing
    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 = App.Path & "\YourAccessDB.mdb"
        
    ElseIf strDBType = "ORACLE" Then
        strDBName = "YOUR_ORACLE_SERVICE_NAME"
    Else
        MsgBox "数据库不符合ORACLE 或者 Microsoft"
        Exit Sub
    End If
    strSQL = "Select * from YOUR_TABLE"
    Set objConn = dbConnection(strDBType, strDBName, "userid", "password")
    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