为什么提示数据库提示不支持更新呢?

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
...全文
105 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
blackbug119 2004-12-17
  • 打赏
  • 举报
回复
rs.只是记录结,就有数据没有SQL语句
blackbug119 2004-12-17
  • 打赏
  • 举报
回复
rs.Refresh
这句有错
这不是ADO控件,你要刷新要在Set rs = conn.Execute(sql)
一次
epzk 2004-12-17
  • 打赏
  • 举报
回复
上面的代码不是,我贴错了。

下面的才是:

Private Sub Command1_Click()
Dim cs
cs = MsgBox("确定要保存吗?", vbYesNo + 48, "初始资料")
If cs = vbYes Then
rs("ccprice") = ccj.Text
rs("ccprice1") = ccj1.Text
rs.Update
rs.Refresh
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim pic
sql = "select * from e_pro where proname='" & Trim(Form5.MSHFlexGrid1.Text) & "'"
Set rs = conn.Execute(sql)
pic = rs("pic")
pic1 = Replace$(pic, "/", "\")
Picture1.Picture = LoadPicture(App.Path & pic1)
proname.Caption = rs("proname")
If IsNull(rs("ccprice")) Then
ccj.Text = ""
Else
ccj.Text = rs("ccprice")
End If
If IsNull(rs("ccprice1")) Then
ccj1.Text = ""
Else
ccj1.Text = rs("ccprice1")
End If
End Sub

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧