这是一个用vb＋SQL Server数据库编写的样品检验代码。包括样品的购买库存以及检验的各项程序

End Sub

Private Sub cmddelete_Click()
X = MsgBox("要删除当前记录吗？", 49, "资料更正")
 '如果删除记录集的最后一条记录
  '记录或记录集中唯一的记录
  If X = 1 Then
  Adodc1.Recordset.Delete
  Adodc1.Recordset.MoveNext
  End If
  If X = 2 Then
  End If
  
  
Adodc1.Refresh
  


End Sub

Private Sub cmdedit_Click()
TxtYPMC.Locked = False
TxtJYXM.Locked = False
TxtJYLS.Locked = False
TxtBZ.Locked = False

cmdexitedit.Enabled = True
cmdsave.Enabled = True

cmdadd.Enabled = False
cmdcancel.Enabled = False
cmddelete.Enabled = False
cmdedit.Enabled = False

Cmdselect.Enabled = True
Cmddel.Enabled = True
Cmdok.Enabled = True

End Sub

Private Sub cmdexitedit_Click()
TxtYPMC.Locked = True
TxtJYXM.Locked = True
TxtJYLS.Locked = True
TxtBZ.Locked = True

cmdadd.Enabled = True
cmddelete.Enabled = True
cmdexitedit.Enabled = False
cmdsave.Enabled = False
cmdedit.Enabled = True

Cmdselect.Enabled = False
Cmddel.Enabled = False
Cmdok.Enabled = False

StatusBar1.Panels(1).Text = "记录总数:" + CStr(Adodc1.Recordset.RecordCount)
StatusBar1.Panels(2).Text = "当前记录号:" + CStr(Adodc1.Recordset.AbsolutePosition)


End Sub

Private Sub cmdsave2_Click()
If txtfilename.Text = "" Then
    MsgBox "文件名 不能为空！", vbOKOnly + vbInformation, "错误"
    txtfilename.SetFocus
ElseIf txtfileformat.Text = "" Then
    MsgBox "文件格式 不能为空！", vbOKOnly + vbInformation, "错误"
    txtfileformat.SetFocus

ElseIf txtauthor.Text = "" Then
    MsgBox "上传人 不能为空！", vbOKOnly + vbInformation, "错误"
    
    txtauthor.SetFocus
    
ElseIf txtpart.Text = "" Then
    MsgBox "上传部门 不能为空！", vbOKOnly + vbInformation, "错误"
    txtpart.SetFocus
    

ElseIf txtprincipal.Text = "" Then
    MsgBox "负责人 不能为空！", vbOKOnly + vbInformation, "错误"
    txtprincipal.SetFocus

Else

    Adodc1.Recordset.Update

    MsgBox "资料修改成功！", vbOKOnly + vbInformation, "修改成功"

'txtFields(0).SetFocus

    cmdadd.Enabled = True
    cmddelete.Enabled = True
    cmdedit.Enabled = True
    cmdexitedit.Enabled = False
    cmdcancel.Enabled = False

    Adodc1.Refresh
    Adodc1.RecordSource = " select * from 文件信息表 order by 上传时间 desc"
    Adodc1.Refresh
    
    txtauthor.Enabled = True
    txtfilename.Enabled = True
    txtfileformat.Enabled = True
    txtauthor.Enabled = True
    txtfilepath.Enabled = True
    Framefileinfo.Enabled = False
     
    cmdsave2.Visible = False
End If
foradd = 0    '用forsave的值来控制dir，使文件路径文本框内容随dir变动。


End Sub

Private Sub Cmdfind_Click()
sqltext = "select * from 样品信息表 where " & ComboCX.Text & "like '%" & TextCX.Text & "%'"
Adodc1.RecordSource = sqltext
Adodc1.Refresh

End Sub

Private Sub Cmdok_Click()
  Dim N_JYXM3(29, 2)
For i = 0 To Listselect.ListCount - 1
   
    S_text = Listselect.List(i)
    N_JYXM3(i, 1) = Left(S_text, 4)
    N_JYXM3(i, 0) = Right(S_text, Len(S_text) - 5)
    Adodc2.RecordSource = "select * from 项目表 where 项目代码 like '" & Left(S_text, 4) & "'"
    Adodc2.Refresh
    N_JYXM3(i, 2) = Trim(Adodc2.Recordset!检验周期)   '要改动数据库 项目表
    
Next i
TxtJYXM.Text = ""

For i = 0 To Listselect.ListCount - 1
    TxtJYXM.Text = TxtJYXM.Text & N_JYXM3(i, 1) & N_JYXM3(i, 2)
Next i


Listall.Clear
Listselect.Clear
SSTab1.Tab = 0

End Sub

Private Sub Cmdrefesh_Click()
sqltext = "select * from 样品信息表"
Adodc1.RecordSource = sqltext
Adodc1.Refresh
End Sub

Private Sub cmdsave_Click()

If TxtJYLS.Text <> "" Then   '此模块检验 检验历史 和 检验项目是否个数一致

N_XM = Len(TxtJYXM.Text) / 5
S_LS = TxtJYLS.Text
S_temp = TxtJYLS.Text
S_len = Len(S_LS)
Do While S_len <> 0
    S_temp = Left(S_LS, 1)
    Select Case S_temp
        Case "N"
            S_len = S_len - 2
            y = y + 1
        Case "M"
            S_len = S_len - 3
            y = y + 1
        Case "Y"
            S_len = S_len - 5
            y = y + 1
    
    End Select
    S_LS = Right(S_LS, S_len)
Loop
If N_XM <> y Then
    MsgBox ("检验历史 和 检验项目 个数不相等！请改正。")
    Exit Sub
End If
End If



If TxtYPMC.Text = "" Then
    MsgBox "样品名称 不能为空！", vbOKOnly + vbInformation, "错误"
    TxtYPMC.SetFocus
ElseIf TxtJYXM.Text = "" Then
    MsgBox "检验项目 不能为空！", vbOKOnly + vbInformation, "错误"
    TxtJYXM.SetFocus
'ElseIf TxtJYLS.Text = "" Then
'    MsgBox "检验历史 不能为空！", vbOKOnly + vbInformation, "错误"
'    TxtJYLS.SetFocus

    
    
Else
    Adodc1.Recordset!样品名称 = Trim(TxtYPMC.Text)
    Adodc1.Recordset!检验项目 = Trim(TxtJYXM.Text)
    Adodc1.Recordset!检验历史 = Trim(TxtJYLS.Text)
    Adodc1.Recordset!备注 = Trim(TxtBZ.Text)

    Adodc1.Recordset.Update

    MsgBox "资料修改成功！", vbOKOnly + vbInformation, "修改成功"



    cmdadd.Enabled = True
    cmddelete.Enabled = True
    cmdedit.Enabled = True
    cmdexitedit.Enabled = False
    cmdcancel.Enabled = False

    Adodc1.Refresh


    cmdsave.Enabled = False
    
    TxtYPMC.Locked = True
TxtJYXM.Locked = True
TxtJYLS.Locked = True
TxtBZ.Locked = True


Cmdselect.Enabled = False
Cmddel.Enabled = False
Cmdok.Enabled = False

End If
End Sub

Private Sub Cmdselect_Click()
Listselect.AddItem (Listall.Text)

Lab_all.Caption = Listall.ListCount
Lab_select.Caption = Listselect.ListCount
End Sub

Private Sub cmdsort_Click()
        Adodc1.RecordSource = "select * from 样品信息表 order by " + Combosort.Text
        Adodc1.Refresh
        

End Sub

Private Sub Form_Load()
SSTab1.Tab = 0
StatusBar1.Panels(1).Text = "记录总数:" + CStr(Adodc1.Recordset.RecordCount)
StatusBar1.Panels(2).Text = "当前记录号:" + CStr(Adodc1.Recordset.AbsolutePosition)
End Sub


Private Sub Listall_DblClick()
Listselect.AddItem (Listall.Text)

Lab_all.Caption = Listall.ListCount
Lab_select.Caption = Listselect.ListCount



End Sub


Private Sub Listselect_DblClick()
Listselect.RemoveItem Listselect.ListIndex

Lab_all.Caption = Listall.ListCount
Lab_select.Caption = Listselect.ListCount
End Sub


Private Sub TxtJYXM_GotFocus()
SSTab1.Tab = 1
Listall.Clear
Listselect.Clear
If TxtJYXM.Text = "" Then   '此时操作应该为 新建

    N_XM = Adodc2.Recordset.RecordCount
    For i = 1 To N_XM
        additemtext = Trim(Adodc2.Recordset!项目代码) & " |" & Trim(Adodc2.Recordset!项目名称)
        Listall.AddItem (additemtext)
        Adodc2.Recordset.MoveNext
    Next i
Else                     '此时操作应该为 修改 要对现有字段进行分析，把现有检验项目显示在listselect中
    O_JYXM = TxtJYXM.Text '原始检验项目字段
    O_len = Len(O_JYXM)
    number_JYXM = O_len / 5
    '下面形成 N_JYXM2 数组 包括 项目名称  项目代码 检验周期
    Dim N_JYXM2(29, 2)
    For i = 0 To number_JYXM - 1
        S_JYXM = Left(O_JYXM, 4)
        N_JYXM2(i, 1) = S_JYXM  '对数组 项目代码 付值
        Adodc2.RecordSource = "select * from 项目表 where 项目代码 like '" & S_JYXM & "'"
        Adodc2.Refresh
        N_JYXM2(i, 0) = Adodc2.Recordset!项目名称  '对数组 项目名称 付值
        O_JYXM = Right(O_JYXM, O_len - 4)
        S_JYZQ = Left(O_JYXM, 1)
        N_JYXM2(i, 2) = S_JYZQ      '对数组 检验周期 付值
        
        O_len = Len(O_JYXM)
        O_JYXM = Right(O_JYXM, O_len - 1)
        O_len = Len(O_JYXM)
    Next i
'下面把N_JYXM2数组的 项目代码＋项目名称 送入到listselect中
For i = 0 To number_JYXM - 1
    S_text = N_JYXM2(i, 1) & " |" & N_JYXM2(i, 0)
    Listselect.AddItem (S_text)
Next i
End If


Adodc2.RecordSource = "select * from 项目表"
Adodc2.Refresh
N_XM = Adodc2.Recordset.RecordCount
For i = 1 To N_XM
    additemtext = Trim(Adodc2.Recordset!项目代码) & " |" & Trim(Adodc2.Recordset!项目名称)
    Listall.AddItem (additemtext)
    Adodc2.Recordset.MoveNext
Next i
    
    
Lab_all.Caption = Listall.ListCount
Lab_select.Caption = Listselect.ListCount

'下面的模块用来显示检验历史的个数
S_LS = TxtJYLS.Text
S_temp = TxtJYLS.Text
S_len = Len(S_LS)
Do While S_len <> 0
    S_temp = Left(S_LS, 1)
    Select Case S_temp
        Case "N"
            S_len = S_len - 2
            y = y + 1
        Case "M"
            S_len = S_len - 3
            y = y + 1
        Case "Y"
            S_len = S_len - 5
            y = y + 1
    
    End Select
    S_LS = Right(S_LS, S_len)
Loop
Lab_ls.Caption = y & "个"
    
End Sub