为何更新不了？老是出错

[hicksys]

出错的提示是：无法为更新定位行。一些值可能在最后一次读取后已更改。

这样的错误该如何处理啊？各位大哥救下命啊~

[junki]

打开数据记录时，应该允许可以读写
然后使用Updata更新

具体的把操作数据库的源程序贴出来

[hicksys]

Public Sub FillToRs(ByRef rsRecordset As adodb.Recordset, ByVal objForm As Form, Optional ByVal strContainerName As String = "")
On Error GoTo FillToRs_Err

Dim intFldNum As Integer
Dim objctl As Object
Dim Fld As adodb.Field
Dim strFldName As String '字段名字
Dim strPart As String
Dim IntDataType As Integer '数据类型

For Each objctl In objForm

If Not (objctl.Tag = "" Or TypeOf objctl Is Label) Then

Set Fld = Nothing
strFldName = PickupTag(objctl, "FldName")

IntDataType = PickupTag(objctl, "DataType")
strPart = Left(objctl.Name, 3)
MsgBox strFldName & " " & CStr(IntDataType) & " " & strPart
Set Fld = rsRecordset.Fields(strFldName)

If Not Fld Is Nothing Then
If StrComp(UCase(objctl.Container.Name), UCase(strContainerName), vbTextCompare) = 0 Or strContainerName = "" Then
Select Case strPart
Case "txt" '对于文本框﹐只用于输入varchar和数值,由于全部栏位的文本型只有varchar形态
If Len(objctl.Text) > 0 Then
Fld.Value = objctl.Text
Else
If Not IsNull(Fld.OriginalValue) Then '如果不等于Null
If Len(Fld.OriginalValue) > 0 Then '如果不等于""
If IntDataType = 200 Then
Fld.Value = ""
ElseIf IntDataType = 135 Then
Fld.Value = Null
Else
Fld.Value = 0
End If
End If
End If
End If
Case "chk"
If objctl.Value Then
Fld.Value = 1
Else
Fld.Value = 0
End If
Case "dtp"
If IntDataType = 135 Then
Fld.Value = objctl.Value
Else
Fld.Value = CStr(objctl.Value)
End If
Case "cmb"
If IntDataType = 200 Then
Fld.Value = objctl.Text
Else
Fld.Value = objctl.ItemData(objctl.ListIndex)
End If
End Select
End If
End If
End If
Next
Set Fld = Nothing
Exit Sub
exit_FillToRs:
Exit Sub
FillToRs_Err:
MsgBox Err.Description, vbCritical, "mdlComm|:FillToRs"
Debug.Print objctl.Name & "-->index:" & objctl.Index & "--->tag:" & objctl.Tag
GoTo exit_FillToRs
End Sub


下面这段程序中，如果调用filltors这个函数就不行，如果不调用就可以进行更新不出错，但是上面的这个FILLTORS是必须要调用的，要不然文本框内的数据保存不了~
Private Sub RsSave()

'On Error GoTo rsSave_Err
Dim tmpAct As ActionEnum
Dim objErr As Object
Dim saveStr As String

tmpAct = curAction

Dim aaa As Integer

If curAction = Insert Or curAction = Modify Then
Set objErr = CheckData(Me)
If Not (objErr Is Nothing) Then
MsgBox "strDataPrompt", vbInformation, Me.Caption
objErr.SetFocus
Exit Sub
End If


Call FillToRs(rsMain, Me)
End If

Call OpenConn(True)
Set rsMain.ActiveConnection = gConn


On Error GoTo Trans_Err

gConn.BeginTrans
rsMain.Properties("Unique Table").Value = strMainTable
rsMain.UpdateBatch
MsgBox "get me "
gConn.CommitTrans

Call RowSave(rsDetail, strDetailTable)
If curAction = Delete Then
Set itemX = UpdateLv(lvMain, curAction) '同步listview中显示内容
Call ResetCtls
Else
Dim strTmpNew As String
strTmpNew = rsMain(strMainkey).Value
Set rsMain = OpenRS(strRsMain, True)
Call FillListView(rsMain, lvMain, strFldName)
Set itemX = lvMain.FindItem(strTmpNew, lvwText, , 0)
If Not itemX Is Nothing Then
itemX.Selected = True
itemX.EnsureVisible
End If
Call LvMain_ItemClick(itemX)
End If
curAction = noAction
lvMain.Enabled = True
Framemain.Enabled = False
lvMain.SetFocus
Call SetToolBar(curAction)

Call SetGridProper(grdDetail, curAction)
Exit Sub

On Error Resume Next


Exit_Sub:
Set rsMain.ActiveConnection = Nothing
Exit Sub
rsSave_Err:
curAction = tmpAct
MsgBox Err.Description, vbCritical, Me.Caption & ":rsSave"
Call RsCancel
GoTo Exit_Sub
Trans_Err:
If Err.Number = -2147217873 Then
MsgBox "strMainRSPrompt" & Err.Description, vbCritical, Me.Caption & ":btnSave"
ElseIf Err.Number = -1111111 Then
MsgBox Err.Description, vbInformation, Me.Caption & ":rsSave"
rsMain.CancelUpdate
GoTo Exit_Sub
Else
MsgBox Err.Description, vbCritical, Me.Caption & ":rsSave"
End If
On Error Resume Next
rsMain.CancelBatch
gConn.RollbackTrans
GoTo Exit_Sub
End Sub

[liyunheng]

佩服!!!强