通过超时判断,参考下例:
Dim cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atServer, 悲观)
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
rs!f1 = "q"
rs.Update
cn.CommitTrans
End If '以下在.Bas
Public Enum adCursorLoc
atClient = 0
atServer
End Enum
Public Enum adLockType
唯读且向前 = 0
悲观
乐观
唯读
End Enum
Public Function adoOpenRecordset(Conn As adodb.Connection, Source, _
Optional CursorLoc As adCursorLoc, Optional LockType As adLockType) As adodb.Recordset
Dim rs As adodb.Recordset
Dim tryTimes As Integer
Dim vv As Variant
Set rs = New adodb.Recordset
If LockType = 唯读且向前 Or LockType = 悲观 Then
CursorLoc = atServer
rs.CacheSize = 1
End If
If CursorLoc = atClient Then
LockType = 乐观
End If
If CursorLoc = atServer Then
rs.CursorLocation = adUseServer
Select Case LockType
Case 唯读, 唯读且向前
rs.LockType = adLockReadOnly
Case 悲观
rs.LockType = adLockPessimistic
Case 乐观
rs.LockType = adLockOptimistic
End Select
Else
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
End If
Err.Clear
On Error GoTo errh
If TypeOf Source Is adodb.Command Then
rs.Open Source
Else
rs.Open Source, Conn
End If
vv = rs.Fields(0).Value
Set adoOpenRecordset = rs
Exit Function
errh:
If Err.Number = -2147467259 Then
'Time Out Lock by Others
If tryTimes < 2 Then
tryTimes = tryTimes + 1
Err.Clear
Resume
Else
Set adoOpenRecordset = Nothing
End If
Else
Set adoOpenRecordset = Nothing
End If
End Function
Dim cn As ADODB.Connection
Private rs As ADODB.Recordset
Private Sub Form_Load()
Dim connstr As String
Dim sql As String
Set cn = New ADODB.Connection connstr = "Data Source=ACCOUNT;UID=sa;PWD=;Initial Catalog=NKIUAcc"
cn.Provider = "SQLOLEDB"
cn.ConnectionString = connstr
cn.Open
sql = "Select * from TESTTAB"
Set rs = adoOpenRecordset(cn, sql, atServer, 悲观)
cn.BeginTrans
If rs Is Nothing Then
cn.RollbackTrans
Else
rs!f1 = "q"
rs.Update
cn.CommitTrans
End If '以下在.Bas
Public Enum adCursorLoc
atClient = 0
atServer
End Enum
Public Enum adLockType
唯读且向前 = 0
悲观
乐观
唯读
End Enum
Public Function adoOpenRecordset(Conn As adodb.Connection, Source, _
Optional CursorLoc As adCursorLoc, Optional LockType As adLockType) As adodb.Recordset
Dim rs As adodb.Recordset
Dim tryTimes As Integer
Dim vv As Variant
Set rs = New adodb.Recordset
If LockType = 唯读且向前 Or LockType = 悲观 Then
CursorLoc = atServer
rs.CacheSize = 1
End If
If CursorLoc = atClient Then
LockType = 乐观
End If
If CursorLoc = atServer Then
rs.CursorLocation = adUseServer
Select Case LockType
Case 唯读, 唯读且向前
rs.LockType = adLockReadOnly
Case 悲观
rs.LockType = adLockPessimistic
Case 乐观
rs.LockType = adLockOptimistic
End Select
Else
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
End If
Err.Clear
On Error GoTo errh
If TypeOf Source Is adodb.Command Then
rs.Open Source
Else
rs.Open Source, Conn
End If
vv = rs.Fields(0).Value
Set adoOpenRecordset = rs
Exit Function
errh:
If Err.Number = -2147467259 Then
'Time Out Lock by Others
If tryTimes < 2 Then
tryTimes = tryTimes + 1
Err.Clear
Resume
Else
Set adoOpenRecordset = Nothing
End If
Else
Set adoOpenRecordset = Nothing
End If
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货