为什么提示数据库提示不支持更新呢?
epzk 2004-12-17 01:43:34 Option Explicit
Private conn As New ADODB.Connection
Private rs As New Recordset
Private rs1 As New Recordset
Private rs2 As New Recordset
Private sql As String
Private sql1 As String
Private sql2 As String
Private Sub aladd_Click()
Dim myal
If anli.Text = "" Then
myal = MsgBox("请输入按力!", vbYes, "omten")
anli.SetFocus
Exit Sub
End If
sql = "select * from jcal where anli='" & Trim(anli.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myal = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("anli") = Trim(anli.Text)
rs.Update
rs.Close
myal = MsgBox("数据提交成功!", vbYes, "omten")
anli.Text = ""
End If
End Sub
Private Sub anbadd_Click()
Dim myanb
If anbcolor.Text = "" Then
myanb = MsgBox("请输入按柄颜色", vbYes, "omten")
anbcolor.SetFocus
Exit Sub
End If
sql = "select * from jcanb where anbcolor='" & Trim(anbcolor.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myanb = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("anbcolor") = Trim(anbcolor.Text)
rs.Update
rs.Close
myanb = MsgBox("数据提交成功!", vbYes, "omten")
anbcolor.Text = ""
End If
End Sub
Private Sub Command1_Click()
Dim myxhgg, cg, myprolei, myproname
If xhgg.Text = "" Then
myxhgg = MsgBox("请输入型号规格!", vbYes, "omten")
xhgg.SetFocus
Exit Sub
End If
If prolei.Text = "" Then
myprolei = MsgBox("请输入产品类别!", vbYes, "omten")
prolei.SetFocus
Exit Sub
End If
If proname.Text = "" Then
myproname = MsgBox("请输入产品中文名称!", vbYes, "omten")
proname.SetFocus
Exit Sub
End If
sql = "select * from jcpro where xhgg='" & Trim(xhgg.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myxhgg = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("xhgg") = Trim(xhgg.Text)
rs("prolei") = Trim(prolei.Text)
rs("proname") = Trim(proname.Text)
rs.Update
rs.Close
cg = MsgBox("数据添加成功!", vbYes, "omten")
xhgg.Text = ""
prolei.Text = ""
proname.Text = ""
End If
End Sub
Private Sub Command2_Click()
If zw.Text = "" Then
Dim myzw
myzw = MsgBox("请输入职位!", vbYes, "omten")
zw.SetFocus
Exit Sub
End If
If xm.Text = "" Then
myzw = MsgBox("请输入姓名!", vbYes, "omten")
xm.SetFocus
Exit Sub
End If
If username.Text = "" Then
myzw = MsgBox("请输入用户名!", vbYes, "omten")
username.SetFocus
Exit Sub
End If
If pwd.Text = "" Then
myzw = MsgBox("请输入密码!", vbYes, "omten")
pwd.SetFocus
Exit Sub
End If
sql = "select * from omt where username='" & Trim(username.Text) & "' and pwd='" & Trim(pwd.Text) & "' and zw='" & Trim(zw.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myzw = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("zw") = Trim(zw.Text)
rs("xm") = Trim(xm.Text)
rs("username") = Trim(username.Text)
rs("pwd") = Trim(pwd.Text)
rs("phone") = Trim(phone.Text)
rs("mob") = Trim(mob.Text)
rs.Update
rs.Close
myzw = MsgBox("数据添加成功!", vbYes, "omten")
zw.Text = ""
xm.Text = ""
username.Text = ""
pwd.Text = ""
phone.Text = ""
mob.Text = ""
End If
End Sub
Private Sub Command3_Click()
If kname.Text = "" Then
Dim myk
myk = MsgBox("请输入库名!", vbYes, "omten")
kname.SetFocus
Exit Sub
End If
sql1 = "select * from jckname where kname='" & Trim(kname.Text) & "'"
rs1.Open sql1, conn, adOpenKeyset, adLockPessimistic
If Not rs1.EOF Then
myk = MsgBox("数据已经存在!", vbYes, "omten")
rs1.Close
Else
rs1.AddNew
rs1("kname") = Trim(kname.Text)
rs1.Update
rs1.Close
myk = MsgBox("数据添加成功!", vbYes, "omten")
kname.Text = ""
End If
End Sub
Private Sub Command4_Click()
If ck.Text = "" Then
Dim myck
myck = MsgBox("请输入仓库的名称!", vbYes, "omten")
ck.SetFocus
Exit Sub
End If
sql2 = "select * from jcck where ck='" & Trim(ck.Text) & "'"
rs2.Open sql2, conn, adOpenKeyset, adLockPessimistic
If Not rs2.EOF Then
myck = MsgBox("数据已经存在!", vbYes, "omten")
rs2.Close
Else
rs2.AddNew
rs2("ck") = Trim(ck.Text)
rs2("qy") = Trim(qy.Text)
rs2("xq") = Trim(xq.Text)
rs2("hg") = Trim(hg.Text)
rs2("jc") = Trim(jc.Text)
rs2.Update
rs2.Close
myck = MsgBox("数据添加成功!", vbYes, "omten")
ck.Text = ""
qy.Text = ""
xq.Text = ""
hg.Text = ""
jc.Text = ""
End If
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Command7_Click()
Unload Me
End Sub
Private Sub Form_Load()
conn.ConnectionString = "Driver={sql server};server=sjf;uid=;pwd=;database=cn114_1"
conn.ConnectionTimeout = 30
conn.Open
End Sub
Private Sub Form_Unload(Cancel As Integer)
conn.Close
End Sub
Private Sub jtadd_Click()
Dim myjt
If jtcolor.Text = "" Then
myjt = MsgBox("请输入机体颜色!", vbYes, "omten")
jtcolor.SetFocus
Exit Sub
End If
sql = "select * from jcjt where jtcolor='" & Trim(jtcolor.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myjt = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("jtcolor") = Trim(jtcolor.Text)
rs.Update
rs.Close
myjt = MsgBox("数据添加成功!", vbYes, "omten")
jtcolor.Text = ""
End If
End Sub
Private Sub packadd_Click()
Dim mypack
If pack.Text = "" Then
mypack = MsgBox("请输入包装情况!", vbYes, "omten")
pack.SetFocus
Exit Sub
End If
sql = "select * from jcpack where pack='" & Trim(pack.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
mypack = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("pack") = Trim(pack.Text)
rs.Update
rs.Close
mypack = MsgBox("数据提交成功!", vbYes, "omten")
pack.Text = ""
End If
End Sub
Private Sub prodjadd_Click()
Dim myprodj
If prodj.Text = "" Then
myprodj = MsgBox("请输入产品等级!", vbYes, "omten")
prodj.SetFocus
Exit Sub
End If
sql = "select * from jcprodj where prodj='" & Trim(prodj.Text) & "'"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
myprodj = MsgBox("数据已经存在!", vbYes, "omten")
rs.Close
Else
rs.AddNew
rs("prodj") = Trim(prodj.Text)
rs.Update
rs.Close
myprodj = MsgBox("数据提交成功!", vbYes, "omten")
prodj.Text = ""
End If
End Sub
Private Sub Text1_Change()
End Sub
Private Sub SSTab1_DblClick()
End Sub