vb操作sql数据库的典型例子

本程序有一菜单开始，里面有查询，删除，修改，添加，程序不一一列出，只写出基本的过程，连接数据库采用标准模块：

'Public publicstr As String
Public conn As ADODB.Connection
Public rs As ADODB.Recordset

Public Sub main()     '数据库连接共享函数
  Set conn = New ADODB.Connection
  conn.Open "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=plgl;Initial Catalog=plgl"
  'publicstr = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=plgl;Initial Catalog=plgl"     '共享连接字符串
  main_pfm.Show
End Sub

 

 

添加程序：

  Set rs = New ADODB.Recordset
  If Trim(Text1(0).Text) = "" Then
    smeg = "配方号不能为空！！！"
    MsgBox smeg, vbOKCancel + vbExclamation, "警告"
    Text1(0).SetFocus
  Else
  If Not IsNumeric(Text1(0).Text) Then
          smeg = "A添加剂非数字！！！"
          MsgBox smeg, vbOKCancel + vbExclamation, "警告"
          Text1(0).Text = ""
          Text1(0).SetFocus
    Else
    If Trim(Text1(1).Text) = "" Then
      smeg = "配方名称不能为空！！！"
      MsgBox smeg, vbOKCancel + vbExclamation, "警告"
      Text1(1).SetFocus
    Else
      If Trim(Text1(2).Text) = "" Then
        smeg = "A添加剂不能为空！！！"
        MsgBox smeg, vbOKCancel + vbExclamation, "警告"
        Text1(2).SetFocus
      Else
        If Not IsNumeric(Text1(2).Text) Then
          smeg = "A添加剂非数字！！！"
          MsgBox smeg, vbOKCancel + vbExclamation, "警告"
          Text1(2).Text = ""
          Text1(2).SetFocus
        Else
          If Trim(Text1(3).Text) = "" Then
            smeg = "B添加剂不能为空！！！"
            MsgBox smeg, vbOKCancel + vbExclamation, "警告"
            Text1(3).SetFocus
          Else
            If Not IsNumeric(Text1(3).Text) Then
              smeg = "B添加剂非数字！！！"
              MsgBox smeg, vbOKCancel + vbExclamation, "警告"
              Text1(3).Text = ""
              Text1(3).SetFocus
            Else
              If Trim(Text1(4).Text) = "" Then
                smeg = "C添加剂不能为空！！！"
                MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                Text1(4).SetFocus
              Else
                If Not IsNumeric(Text1(4).Text) Then
                  smeg = "C添加剂非数字！！！"
                  MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                  Text1(4).Text = ""
                  Text1(4).SetFocus
                Else
                  If Trim(Text1(5).Text) = "" Then
                    smeg = "K系数不能为空！！！"
                    MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                    Text1(5).SetFocus
                  Else
                    If Not IsNumeric(Text1(5).Text) Then
                      smeg = "K系数非数字！！！"
                      MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                      Text1(5).Text = ""
                      Text1(5).SetFocus
                    Else
                      sql = "select * from pfb where 配方号='" & Text1(0).Text & "'"
                      rs.Open sql, conn, 3, 3
                      If rs.EOF Then
                         rs.AddNew
                         rs("配方号") = Text1(0).Text
                         rs("配方名称") = Text1(1).Text
                         rs("A添加剂") = Text1(2).Text
                         rs("B添加剂") = Text1(3).Text
                         rs("C添加剂") = Text1(4).Text
                         rs("K系数") = Text1(5).Text
                         MsgBox "添加成功！！！", vbOKOnly
                         rs.Update
                         rs.Close
                         Set rs = Nothing
                          '**********************************************调整修改后再显示时能实时更新
                         Set rs = New ADODB.Recordset
                         sql = "select * from pfb"
                         rs.Open sql, conn, 3, 3
                         rs.Update
                         Set show_allpf.MSHFlexGrid1.DataSource = rs
                         'show_allpf.Visible = True
                         rs.Close
                       Else
                         MsgBox "此序号已经存在！", vbOKOnly + vbExclamation, "警告"
                         Text1(0).SetFocus
                         End If
                       End If
                     End If
                   End If
                 End If
               End If
             End If
           End If
         End If
       End If
     End If
   End If
  'Command2.Enabled = False     '不能重复保存

 

 

删除：

 'show_allpf.Visible = False
  Set rs = New ADODB.Recordset
  Dim n As String
  Dim sql As String
  Dim c
flag:
  n = InputBox("输入要删除的配方号：")
  If Trim(n) = "" Then    '排除未输入空值的情况
    MsgBox ("删除的配方号不能为空！！！")
    set_pf.Visible = True
  Else
    If Not IsNumeric(n) Then     '排除非数字
      MsgBox "输入的配方号不是数字！！！", vbOKOnly + vbExclamation, "警告"
      GoTo flag
    Else
      sql = "select * from pfb where 配方号='" & n & "'"
      rs.Open sql, conn, 3, 3
      If rs.RecordCount > 0 Then
        c = MsgBox("确认要删除此配方吗？", vbOKCancel + vbExclamation, "警告")     '删除前再次确认
        If c = vbOK Then
          rs.Delete
          MsgBox ("删除成功！")
          'rs.Update
          rs.Close
          Set rs = Nothing
          '**********************************************调整删除后再显示时能实时更新
          Set rs = New ADODB.Recordset
          sql = "select * from pfb"
          rs.Open sql, conn, 3, 3
          Set show_allpf.MSHFlexGrid1.DataSource = rs
          'show_allpf.Visible = True
        Else
          set_pf.Visible = True      '删除成功返回主菜单
        End If
      Else
        MsgBox "无此配方，无可删除信息！", 64, "配方管理"
      End If
    End If
  End If

 

 

修改：

  Set rs = New ADODB.Recordset
  If Trim(Text1(0).Text) = "" Then
    smeg = "配方号不能为空！！！"
    MsgBox smeg, vbOKCancel + vbExclamation, "警告"
    Text1(0).SetFocus
  Else
    If Trim(Text1(1).Text) = "" Then
      smeg = "配方名称不能为空！！！"
      MsgBox smeg, vbOKCancel + vbExclamation, "警告"
      Text1(1).SetFocus
    Else
      If Trim(Text1(2).Text) = "" Then
        smeg = "A添加剂不能为空！！！"
        MsgBox smeg, vbOKCancel + vbExclamation, "警告"
        Text1(2).SetFocus
      Else
        If Not IsNumeric(Text1(2).Text) Then
          smeg = "A添加剂非数字！！！"
          MsgBox smeg, vbOKCancel + vbExclamation, "警告"
          Text1(2).Text = ""
          Text1(2).SetFocus
        Else
          If Trim(Text1(3).Text) = "" Then
            smeg = "B添加剂不能为空！！！"
            MsgBox smeg, vbOKCancel + vbExclamation, "警告"
            Text1(3).SetFocus
          Else
            If Not IsNumeric(Text1(3).Text) Then
              smeg = "B添加剂非数字！！！"
              MsgBox smeg, vbOKCancel + vbExclamation, "警告"
              Text1(3).Text = ""
              Text1(3).SetFocus
            Else
              If Trim(Text1(4).Text) = "" Then
                smeg = "C添加剂不能为空！！！"
                MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                Text1(4).SetFocus
              Else
                If Not IsNumeric(Text1(4).Text) Then
                  smeg = "C添加剂非数字！！！"
                  MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                  Text1(4).Text = ""
                  Text1(4).SetFocus
                Else
                  If Trim(Text1(5).Text) = "" Then
                    smeg = "K系数不能为空！！！"
                    MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                    Text1(5).SetFocus
                  Else
                    If Not IsNumeric(Text1(5).Text) Then
                      smeg = "K系数非数字！！！"
                      MsgBox smeg, vbOKCancel + vbExclamation, "警告"
                      Text1(5).Text = ""
                      Text1(5).SetFocus
                    Else
                      sql = "select * from pfb where 配方号='" & Text1(0).Text & "'"
                      rs.Open sql, conn, 3, 3
                      rs("配方名称") = Text1(1).Text
                      rs("A添加剂") = Text1(2).Text
                      rs("B添加剂") = Text1(3).Text
                      rs("C添加剂") = Text1(4).Text
                      rs("K系数") = Text1(5).Text
                      rs.Update
                      rs.Close
                      Set rs = Nothing
                      MsgBox "修改成功！！！", vbOKOnly
                      Command1.Enabled = False
                       '**********************************************调整修改后再显示时能实时更新
                      Set rs = New ADODB.Recordset
                      sql = "select * from pfb"
                      rs.Open sql, conn, 3, 3
                      rs.Update
                      Set show_allpf.MSHFlexGrid1.DataSource = rs
                      'show_allpf.Visible = True
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If

 

 

显示：

  Set rs = New ADODB.Recordset
  Dim r As Integer, c As Integer
  MSHFlexGrid1.CellBackColor = &HC0FFFF
  sql = "select * from pfb"
  rs.Open sql, conn, adOpenDynamic, adLockOptimistic
 
  'rs.Update
  With MSHFlexGrid1
       

    Set .DataSource = rs
    .Refresh
    .AllowBigSelection = True
    '.ColWidth(0) = 200
    For r = 0 To .Rows - 1 Step 2     '对表格进行各行颜色变换
      For c = 0 To .Cols - 1
        .Row = r
        .Col = c
        .CellBackColor = &HC0FFC0
      Next c
    Next r
        .Row = 0
        .SelectionMode = flexSelectionByRow
        .ColSel = 0

  rs.Close
  Set rs = Nothing
  End With