Private Sub btnSave_Click()
On Error GoTo ErrorHandler
If Not CheckRequired(Me) Then Exit Sub
If Not CheckTextLength(Me) Then Exit Sub
If Not CheckRequired(Me.sfrDetail) Then Exit Sub
Dim cnn: Set cnn = CurrentProject.Connection 'ADO.Connection()
cnn.BeginTrans
Dim blnTransBegin As Boolean: blnTransBegin = True
Dim strSQL: strSQL = "SELECT * FROM [OSI主要部件入库单] WHERE [入库单ID]=" & Nz(Me![入库单ID], 0)
Dim rst: Set rst = ado.OpenRecordset(strSQL, adLockOptimistic, cnn)
If rst.EOF Then rst.AddNew
updaterecord Me, rst
'你的自定义代码
'rst!Field1 = Me!Field1
'rst!Field2 = Me!Field2
rst.Update
Me.[入库单ID] = rst("入库单ID")
rst.Close
cnn.Execute "DELETE FROM [OSI主要部件入库单详细] WHERE [入库单ID]=" & Nz(Me![入库单ID], 0)
strSQL = "SELECT * FROM [OSI主要部件入库单详细] WHERE [入库单ID]=" & Nz(Me![入库单ID], 0)
Set rst = ado.OpenRecordset(strSQL, adLockOptimistic, cnn)
Dim rstTmp: Set rstTmp = CurrentDb.OpenRecordset("TMP_OSI主要部件入库单详细")
Do Until rstTmp.EOF
rst.AddNew
updaterecord rstTmp, rst
'你的自定义代码
'rst!Field1 = Me!Field1
'rst!Field2 = Me!Field2
rst("入库单ID") = Me![入库单ID]
rst.Update
rstTmp.MoveNext
Loop
rst.Close
rstTmp.Close
用模块生成窗体,加了绿色的字段后,程序正常。
但添加了新的rs记录集,在update的地方就开始报错。 需要输入ID,但这个ID 在红色地方已经赋值了。
把新的rs程序全部删除后,依然报错。需要重新生成窗体,添加绿色语句后,程序可正常。
反复多次,处理不了。这是不是程序的bug?