我的程序在运行时有时会出现“运行多步操作时错误”,但并不是常会出现这种错误,只是偶尔会出现,另外我的数据表也都设计的有主键。我把其中一个保存数据的代码贴在下面这是一个完成按扭的CLICK事件:
Dim rd As ADODB.Recordset      '数据集变量
Dim n As Integer         'msgbox变量
Dim brithday As String
Dim num As Integer         ''''''''''''''''''''''''''
          '判断必填项是否已输入
        ''''''''''''''''''''''''''''
If Trim$(cmbunit.Text) = "" Then
MsgBox "单位名称为必填项,请您输入!"
cmbunit.SetFocus
Exit Sub
End If
If Trim$(txtname.Text) = "" Then
MsgBox "客户姓名为必填项,请您输入!"
txtname.SetFocus
Exit Sub
End IfIf Trim$(cmbsex.Text) = "" Then
MsgBox "性别为必选项,请您选择!"
cmbsex.SetFocus
Exit Sub
End If
'''''''''''''''''''''''''''''
'判断生日否输入
''''''''''''''''''''''''''''
If Trim$(cmbmon.Text) = "" Then
cmbmon.Text = "00"
Else
cmbmon.Text = cmbmon.Text
End If
If Trim$(cmbday.Text) = "" Then
cmbday.Text = "00"
Else
cmbday.Text = cmbday.Text
End If
brithday = cmbmon.Text & "\" & cmbday.Text      '生日合成
 If wintxt = False Then
         ''''''''''''''''''''''''''
        '添加新的客户基本资料
       '''''''''''''''''''''''''''''''''
' '''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 
'''''''''''''''''''
'添加
'''''''''''''''''''
n = 0
n = MsgBox("确认对此客户资料进行保存?", vbYesNo, "询问")
Select Case n
Case vbYes
''''''''''''''''''''''''''
'判断在<单位>表是否有cmbunit.text,如没有,则先在<单位>表中增加cmbunit.text记录,如有则不增加
'''''''''''''''''''''''''''
Adodc1.RecordSource = "select * from unit where unitname like" & "'" & Trim$(cmbunit.Text) & "'" & ""
Adodc1.Refresh
Set rd = Adodc1.Recordset
If rd.RecordCount < 1 Then
rd.addnew
rd.Fields(1).Value = Trim$(cmbunit.Text)
rd.Update
End If
''''''''''''''''
'释放数据集变量
'''''''''''''''''
Adodc1.RecordSource = ""
Set rd = Nothing
'''''''''''''''''
'增加客户资料表(MAIN)记录
'''''''''''''''''''''''''''
Adodc1.RecordSource = "select * from main"
Adodc1.Refresh
Set rd = Adodc1.Recordset
num = rd.RecordCount
rd.addnew
'rd.Fields(0).Value = num + 1
rd.Fields(1).Value = Trim$(cmbunit.Text)
rd.Fields(2).Value = Trim$(txtname.Text)
rd.Fields(3).Value = Trim$(txtjob.Text)
rd.Fields(4).Value = Trim$(cmbsex.Text)
rd.Fields(5).Value = brithday
rd.Fields(6).Value = Val(txtage.Text)
rd.Fields(7).Value = Trim$(cmbpart.Text)
rd.Fields(8).Value = Trim$(txtofficephone.Text)
rd.Fields(9).Value = Trim$(txthandphone.Text)
rd.Fields(10).Value = Trim$(txtemail.Text)
rd.Fields(11).Value = Trim$(txtdress.Text)
rd.Fields(12).Value = Trim$(txtperson.Text)
rd.Fields(13).Value = Trim$(txtfamily.Text)
rd.Fields(14).Value = Trim$(txtlike.Text)
rd.Update
'''''''''''''''''''''''''
' 释放数据集变量
''''''''''''''''
Adodc1.RecordSource = ""
Set rd = Nothingcmdcancel.Enabled = False
If Chkbf.Value = 1 Then              '判断是否继续增加拜访记录,选中为继续增加,不选为不增加
MDIForm1.ucjbzl1.Visible = False
MDIForm1.ucbfin1.Visible = True
addt = True             '设置拜访窗体中单位名称和客户姓名是否为不可用
unitname = cmbunit.Text '如继续增加拜访记录传递单位名称
username = txtname.Text '如如继续增加拜访记录传递客户姓名
Else
addt = False
unitname = ""
username = ""
'cmdnext.Enabled = True
cmdfinish.Enabled = False
End If
cmbunit.Text = ""
txtname.Text = ""
txtjob.Text = ""
txtofficephone.Text = ""
txthandphone.Text = ""
txtemail.Text = ""
txtdress.Text = ""
txtfamily.Text = ""
txtlike.Text = ""
txtperson.Text = ""
cmbday.Text = ""
cmbmon.Text = ""
'cmbsex.Text = ""
cmdfinish.Enabled = True
'cmdnext.Enabled = False
Case Cancel
End SelectEnd IfIf wintxt = True Then                 '修改记录
''''''''''''''''''''''''
'''修改客户基本资料
'''''''''''''''''''''''
Dim yn As Integer
yn = MsgBox("确认要保存修改?", vbYesNo, "询问")
Select Case yn
Case vbYes
''''''''''''''''''''''''''
'判断在<单位>表是否有cmbunit.text,如没有,则先在<单位>表中增加cmbunit.text记录,如有则不增加
'''''''''''''''''''''''''''
Adodc1.RecordSource = "select * from unit where unitname like" & "'" & Trim$(cmbunit.Text) & "'" & ""
Adodc1.Refresh
Set rd = Adodc1.Recordset
If rd.RecordCount < 1 Then
rd.addnew
rd.Fields(1).Value = Trim$(cmbunit.Text)
rd.Update
End If
'''''''''''''''''''''''''
' 释放数据集变量
''''''''''''''''
Adodc1.RecordSource = ""
Set rd = Nothing
'''''''''''''''''
'修改客户资料表(MAIN)记录
'''''''''''''''''''''''''''Adodc1.RecordSource = "select * from main where unit like" & "'" & zlunit & "'" & " and name like " & "'" & zlname & "'" & ""
Adodc1.Refresh
Set rd = Adodc1.Recordset
rd.delete
rd.addnew
'rd.Fields(0).Value = idnum
rd.Fields(1).Value = Trim$(cmbunit.Text)
rd.Fields(2).Value = Trim$(txtname.Text)
rd.Fields(3).Value = Trim$(txtjob.Text)
rd.Fields(4).Value = Trim$(cmbsex.Text)
rd.Fields(5).Value = Trim$(txtmonday.Text)
rd.Fields(6).Value = Val(txtage.Text)
rd.Fields(7).Value = Trim$(cmbpart.Text)
rd.Fields(8).Value = Trim$(txtofficephone.Text)
rd.Fields(9).Value = Trim$(txthandphone.Text)
rd.Fields(10).Value = Trim$(txtemail.Text)
rd.Fields(11).Value = Trim$(txtdress.Text)
rd.Fields(12).Value = Trim$(txtperson.Text)
rd.Fields(13).Value = Trim$(txtfamily.Text)
rd.Fields(14).Value = Trim$(txtlike.Text)
rd.Update
Set rd = Nothing
cmdfinish.Enabled = False
cmdcancel.Enabled = True
viewsf = True
Case Cancel
End SelectEnd If