On Error GoTo ErrorHandler
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim strExpr As String
Dim strtrcode As String
Dim bm As String
Dim Savetime As Double
'检查必填项未通过时退出
If Not CheckRequired(Me) Then Exit Sub
If Nz(DCount("*", "Temp_tbl_Repair_Item_Detail"), 0) = 0 Then
MsgBox "记录为空，请输入记录！", vbCritical, "提示"
Exit Sub
End If
bm = Me.ToDep.Column(1)
Set rst = New ADODB.Recordset
rst.Source = " SELECT * FROM [" & conTableName & "]"
rst.Open , CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Me(conFieldName).Value = AutoNum(conTableName, conFieldName, 6, bm)
rst.AddNew
For Each fld In rst.Fields
fld.Value = Me(fld.name).Value
Next
rst.Update
rst.Close strExpr = SQLExpr(conTableName, conFieldName, Me(conFieldName).Value)
DoCmd.SetWarnings False
'更新临时表主键字段
DoCmd.RunSQL "UPDATE Temp_tbl_Repair_Item_Detail SET " & strExpr
If Me.Status = "完成" Then
DoCmd.RunSQL "UPDATE Temp_tbl_Repair_Item_Detail SET Temp_tbl_Repair_Item_Detail.Check_ok = -1, Temp_tbl_Repair_Item_Detail.FinishDate = Date()" _
& " WHERE Temp_tbl_Repair_Item_Detail.Check_ok=0 and Temp_tbl_Repair_Item_Detail.PZCode='" & Me.PZCode & "';"
End If
DoCmd.RunSQL " INSERT INTO tbl_Repair_Item_Detail(PZCode,Check_ok,FinishDate,Wocode,StyleNo,Alloycode,Qty,F_weight,F_Stone,Remark)" _
& " SELECT PZCode,Check_ok,FinishDate,Wocode,StyleNo,Alloycode,Qty,F_weight,F_Stone,Remark" _
& " FROM Temp_tbl_Repair_Item_Detail" _
& " WHERE (((Temp_tbl_Repair_Item_Detail.Wocode) Is Not Null))" _
& " ORDER BY Temp_tbl_Repair_Item_Detail.ID;"
' DoCmd.RunSQL " INSERT INTO tbl_Repair_Item_Detail(PZCode,Check_ok,FinishDate,Wocode,StyleNo,Alloycode,Qty,F_weight,F_Stone,Remark)" _
' & " SELECT PZCode,Check_ok,FinishDate,Wocode,StyleNo,Alloycode,Qty,F_weight,F_Stone,Remark" _
' & " FROM Temp_tbl_Repair_Item_Detail" _
' & " WHERE (((Temp_tbl_Repair_Item_Detail.Wocode) Is Not Null))" _
' & " ORDER BY Temp_tbl_Repair_Item_Detail.ID;"
' MsgBox "数据已保存。", vbInformation, "提示"
Call cmdNew_Click
On Error Resume Next
With Forms!usysfrmMain!frmChild
.Requery
.Form.Recorset.FindFirst strExpr
End With
ExitHere:
Set rst = Nothing
Set fld = Nothing
Exit Sub
ErrorHandler:
If Err = 24651 Then
Resume Next
Else
ErrMsgBox Me.Caption, "保存按钮_单击"
Resume ExitHere
End If
以上是运行的代码
