通过超时判断,参考下例:
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