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
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
解决方案 »
- 有对Xtreme SuitePro Chart比较熟悉的进来帮我一下
- 求 防直接拷贝的代码
- VB 制作msi安装包问题
- Label被Picture覆盖了
- 感谢flyingZFX为VB版所作的贡献,做散分100,以示谢意!
- 用过ActiveBar2.0的朋友进来?
- 请问sql server的事务begintrans是不是不可以和 adOpenKeyset adLockOptimistic 一时使用??
- 为什么我用MatrixVB不能求导?
- 我想把抓的屏幕直接保存成图片怎么做
- 大难题!!!
- 如何判断一个窗口是否得到了焦点(这个窗口不是程序本身的窗口)
- 请问自己写的OCX如何可以在看网页的时候上载啊!
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
这句有错
这不是ADO控件,你要刷新要在Set rs = conn.Execute(sql)
一次