ADO連接Oracle Access示例及記錄集處理源碼

Option Explicit
Public Enum RSMethod
    VIEW_RECORD [color=#0000ff]= 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
        '定義 Oracle 數據庫連接字符串
        strConnectionString = "Driver={Microsoft ODBC Driver For Oracle};ConnectString=" & strDBService & ";UID=" & strUserID & ";PWD=" & strPassWord & ";"
    ElseIf strDatabaseType = "MSAccess" Then
        '定義 Microsoft 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 = "你的表名稱"
    strPassWord = "密碼"
    strUserID = "帳號"
    


    If strDBType = "MSAccess" Then
        ' strDBName 是數據庫名稱
        strDBName = App.Path & "\YourAccessDB.mdb"
        
    ElseIf strDBType = "Oracle" Then
        ' strDBName 是Oracle 服務器名稱
        strDBName = "你的Oracle 服務器名稱"
        strTableName = strUserID & "." & strTableName
        'Table name format ::> USERID.TABLENA
        '     ME
    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 p
    '     art 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 o
    '     f 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