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 StringPrivate Sub aladd_Click()
Dim myal
If anli.Text = "" Then
myal = MsgBox("请输入按力!", vbYes, "omten")
anli.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub anbadd_Click()
Dim myanb
If anbcolor.Text = "" Then
myanb = MsgBox("请输入按柄颜色", vbYes, "omten")
anbcolor.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub Command1_Click()
Dim myxhgg, cg, myprolei, myproname
If xhgg.Text = "" Then
myxhgg = MsgBox("请输入型号规格!", vbYes, "omten")
xhgg.SetFocus
Exit Sub
End IfIf prolei.Text = "" Then
myprolei = MsgBox("请输入产品类别!", vbYes, "omten")
prolei.SetFocus
Exit Sub
End IfIf proname.Text = "" Then
myproname = MsgBox("请输入产品中文名称!", vbYes, "omten")
proname.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub Command2_Click()
If zw.Text = "" Then
Dim myzw
myzw = MsgBox("请输入职位!", vbYes, "omten")
zw.SetFocus
Exit Sub
End IfIf xm.Text = "" Then
myzw = MsgBox("请输入姓名!", vbYes, "omten")
xm.SetFocus
Exit Sub
End IfIf username.Text = "" Then
myzw = MsgBox("请输入用户名!", vbYes, "omten")
username.SetFocus
Exit Sub
End IfIf pwd.Text = "" Then
myzw = MsgBox("请输入密码!", vbYes, "omten")
pwd.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub Command3_Click()
If kname.Text = "" Then
Dim myk
myk = MsgBox("请输入库名!", vbYes, "omten")
kname.SetFocus
Exit Sub
End Ifsql1 = "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 SubPrivate Sub Command4_Click()
If ck.Text = "" Then
Dim myck
myck = MsgBox("请输入仓库的名称!", vbYes, "omten")
ck.SetFocus
Exit Sub
End Ifsql2 = "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 IfEnd SubPrivate Sub Command5_Click()
Unload Me
End SubPrivate Sub Command6_Click()
Unload Me
End SubPrivate Sub Command7_Click()
Unload Me
End SubPrivate Sub Form_Load()
conn.ConnectionString = "Driver={sql server};server=sjf;uid=;pwd=;database=cn114_1"
conn.ConnectionTimeout = 30
conn.Open
End SubPrivate Sub Form_Unload(Cancel As Integer)
conn.Close
End SubPrivate Sub jtadd_Click()
Dim myjt
If jtcolor.Text = "" Then
myjt = MsgBox("请输入机体颜色!", vbYes, "omten")
jtcolor.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub packadd_Click()
Dim mypack
If pack.Text = "" Then
mypack = MsgBox("请输入包装情况!", vbYes, "omten")
pack.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub prodjadd_Click()
Dim myprodj
If prodj.Text = "" Then
myprodj = MsgBox("请输入产品等级!", vbYes, "omten")
prodj.SetFocus
Exit Sub
End Ifsql = "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 SubPrivate Sub Text1_Change()End SubPrivate Sub SSTab1_DblClick()End Sub

解决方案 »

  1.   

    上面的代码不是,我贴错了。下面的才是: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 SubPrivate Sub Command2_Click()
    Unload Me
    End SubPrivate 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
      

  2.   

    rs.Refresh
    这句有错
    这不是ADO控件,你要刷新要在Set rs = conn.Execute(sql)
    一次
      

  3.   

    rs.只是记录结,就有数据没有SQL语句