Article ID: 179226
Article Last Modified on 6/28/2004
Option Explicit
'SQL Server specific connection options
Private Const SQL_PRESERVE_CURSORS As Long = 1204
Private Const SQL_PC_ON As Long = 1
Private Const SQL_PC_OFF As Long = 0
'Possible ODBC function returns
Private Const SQL_ERROR As Integer = -1
Private Const SQL_INVALID_HANDLE As Integer = -2
Private Const SQL_NO_DATA_FOUND As Integer = 100
Private Const SQL_SUCCESS As Integer = 0
Private Const SQL_SUCCESS_WITH_INFO As Integer = 1
Private Declare Function SQLSetConnectOption Lib "odbc32.dll" _
(ByVal hdbc As Long, ByVal fOption As Integer, pvParam As Any) _
As Integer
Private Declare Function SQLGetConnectOption Lib "odbc32.dll" _
(ByVal hdbc As Long, ByVal fOption As Integer, pvParam As Any) _
As Integer
Private Sub Command1_Click()
Dim intRet As Integer
Dim lngConnOption As Long
Dim Conn As rdoConnection
Dim Rslt As rdoResultset
'Make DSN-less connection. CHANGE SERVER UID PWD for your server
Set Conn = rdoEnvironments(0).OpenConnection(_
"", rdDriverComplete, False, _
"DRIVER={SQL Server};SERVER=hoohaa;DSN=;DATABASE=pubs;UID=<username>;PWD=<strong password>;")
'Getting connection option
intRet = SQLGetConnectOption(Conn.hdbc, SQL_PRESERVE_CURSORS, _
lngConnOption)
If SQL_SUCCESS <> intRet Then
MsgBox "SQLGetConnectOption Failed", "ERROR", vbCritical
Conn.Close
Exit Sub
End If
'display it
Select Case lngConnOption
Case SQL_PC_OFF
MsgBox "Cursor Behavior: Close", , "Connection Option Value"
Case SQL_PC_ON
MsgBox "Cursor Behavior: Maintain", , "Connection Option Value"
Case Else
MsgBox "ERROR: Unknown Connection Option", , _
"Connection Option Value", vbCritical
End Select
'uncomment the next 2 lines to stop error
'intRet = SQLSetConnectOption(Conn.hdbc, SQL_PRESERVE_CURSORS, ByVal _
'SQL_PC_ON)
If intRet <> SQL_SUCCESS Then
MsgBox "SQLSetConnectOption Failed", , "ERROR", vbCritical
Conn.Close
Exit Sub
End If
MsgBox "Connection Option Set to SQL_PC_ON", , _
"Connection Option Status"
Set Rslt = Conn.OpenResultset("select * from authors", _
rdOpenDynamic, rdConcurValues)
Conn.BeginTrans
Rslt.MoveFirst
Rslt.Edit
Rslt.rdoColumns("address").Value = "test"
Rslt.Update
'will error on this line if connection option not set
Conn.RollbackTrans
Rslt.MoveLast
Rslt.Close
Conn.Close
End Sub
Keywords: kbprb KB179226