部门记录档案操作过程中，为什么窗体界中没有删除而数据库中已经删除，请帮我修改一下代码，谢谢

Question

模块代码如下：
Public strServerName As String
Public con As Connection
Public rs As Recordset
Public com As CommandPublic Sub getSQLServerName()
    If GetSetting("OnlineBankingDB", "SQL Server Name", "ServerName") = "" Then
        strServerName = InputBox("请输入数据库服务器名称")
        SaveSetting "OnlineBankingDB", "SQL Server Name", "ServerName", strServerName
    Else
        strServerName = GetSetting("OnlineBankingDB", "SQL Server Name", "ServerName")
    End If
End SubPublic Sub connectionSQLServer()
    Set con = New Connection
    Set rs = New Recordset
    Set com = New Command
    
    On Error GoTo errorhandler
    Call getSQLServerName
    
    Set con = New Connection
    With con
        .Provider = "sqloledb"
        .ConnectionString = "user id=sa;" & _
        "password=810614;" & _
        "data source=" & strServerName & _
        ";initial catalog=OnlineBankingDB"
        .Open
    End With
    
    com.ActiveConnection = con
    Exit Sub
errorhandler:
   MsgBox Err.Number & Err.Source & Err.Description
End Sub窗体代码如下：
Option Explicit
Dim i As Integer
Dim blnStatus As Boolean
Dim intPosition As IntegerPrivate Sub fillList()
On Error GoTo errorhandler
    List1.Clear
    rs.Requery
    rs.MoveFirst
    While Not rs.EOF
        List1.AddItem rs("vDepartmentName")
        rs.MoveNext
    Wend
    rs.MoveFirst
    Call display
    Exit Sub
errorhandler:
   MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbInformation, "部门管理"
End SubPrivate Sub display()
    On Error GoTo errorhandler
    txtID = rs("cDepartmentID") & " "
    txtName = rs!vDepartmentName & " "
    txtHead = rs.Fields(2) & " "
    txtAddress = rs(3) & " "
    Exit Sub
errorhandler:
   MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbInformation, "部门管理"
End SubPrivate Sub disallow()
    Toolbar1.Buttons(1).Enabled = True
    Toolbar1.Buttons(2).Enabled = False
    Toolbar1.Buttons(3).Enabled = True
    Toolbar1.Buttons(4).Enabled = False
    Toolbar1.Buttons(5).Enabled = True
    Toolbar1.Buttons(6).Enabled = True
End SubPrivate Sub allow()
    Toolbar1.Buttons(1).Enabled = False
    Toolbar1.Buttons(2).Enabled = True
    Toolbar1.Buttons(3).Enabled = False
    Toolbar1.Buttons(4).Enabled = True
    Toolbar1.Buttons(5).Enabled = False
    Toolbar1.Buttons(6).Enabled = True
End SubPrivate Sub Form_Load()
    Call connectionSQLServer
    If rs.State = adStateOpen Then rs.Close
    rs.Open "select * from Department order by cDepartmentID", con, adOpenDynamic, adLockOptimistic
    Call fillList
    Call disallow
End SubPrivate Sub List1_Click()
    intPosition = List1.ListIndex
    rs.MoveFirst
    rs.Move intPosition
    Call display
End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "add"
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then
        Controls(i).Enabled = True
        Controls(i).Text = ""
        End If
    Next
    rs.AddNew
    Call allow
Case "save"
    blnStatus = True
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then
            If Controls(i).Text = "" Then
                MsgBox "资料填写不完整，请检查", vbInformation, "部门管理"
                blnStatus = False
                Exit For
            End If
        End If
    Next
    
    If blnStatus = True Then
        rs("cDepartmentID") = txtID.Text
        rs("vDepartmentName") = txtName.Text
        rs("vDepartmentHead") = txtHead.Text
        rs("vLocation") = txtAddress.Text
        rs.Update
        MsgBox "记录已经成功保存到数据库", vbInformation, "部门管理"
        Call fillList
        For i = 0 To Controls.Count - 1
            If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = False
        Next
        Call disallow
    End If
Case "delete"
On Error GoTo errorhandler
    rs.Delete
    rs.MoveNext
    If rs.EOF Then rs.MoveFirst
    Call fillList
    Exit Sub
errorhandler:
   MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbInformation, "部门管理"
Case "cancel"
On Error GoTo errorhandler_cancel
    rs.CancelUpdate
    rs.MoveFirst
    Call display
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = False
    Next
    Call disallow
    Exit Sub
errorhandler_cancel:
   MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbInformation, "部门管理"
Case "update"
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = True
    Next
    Call allow
Case "exit"
    Unload Me
End Select
End Sub附：SQL数据库表
create table Department
(
cDepartmentID char(4) constraint pkDepartment primary key,
vDepartmentName varchar(20),
vDepartmentHead varchar(20),
vLocation varchar(200)
)

Answer 1

全部代码帮楼主调试如下Option Explicit
Dim i As Integer
Dim blnStatus As Boolean
Dim intPosition As IntegerPrivate Sub fillList()
On Error GoTo errorhandler
    List1.Clear
    rs.Requery
    rs.MoveFirst
    While Not rs.EOF
        List1.AddItem rs("vDepartmentName")
        rs.MoveNext
    Wend
    rs.MoveFirst
    Call display
    Exit Sub
errorhandler:
   MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbInformation, "部门管理"
End SubPrivate Sub display()
    txtID = rs("cDepartmentID")
    txtName = rs!vDepartmentName
    txtHead = rs.Fields(2)
    txtAddress = rs(3)
End SubPrivate Sub disallow()
    Toolbar1.Buttons(1).Enabled = True
    Toolbar1.Buttons(2).Enabled = False
    Toolbar1.Buttons(3).Enabled = True
    Toolbar1.Buttons(4).Enabled = False
    Toolbar1.Buttons(5).Enabled = True
    Toolbar1.Buttons(6).Enabled = True
End SubPrivate Sub allow()
    Toolbar1.Buttons(1).Enabled = False
    Toolbar1.Buttons(2).Enabled = True
    Toolbar1.Buttons(3).Enabled = False
    Toolbar1.Buttons(4).Enabled = True
    Toolbar1.Buttons(5).Enabled = False
    Toolbar1.Buttons(6).Enabled = True
End SubPrivate Sub Form_Load()
    Call connectionSQLServer
    If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from Department order by cDepartmentID", con, adOpenDynamic, adLockOptimistic
    Call fillList
    Call disallow
End SubPrivate Sub List1_Click()
    intPosition = List1.ListIndex
    rs.MoveFirst
    rs.Move intPosition
    Call display
End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "add"
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then
            Controls(i).Enabled = True
            Controls(i).Text = ""
        End If
    Next
    rs.AddNew
    Call allow
Case "save"
    blnStatus = True
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then
            If Controls(i).Text = "" Then
                MsgBox "资料填写不完整，请检查", vbInformation, "部门管理"
                blnStatus = False
                Exit For
            End If
        End If
    Next
    If blnStatus = True Then
        rs(0) = txtID.Text
        rs(1) = txtName.Text
        rs(2) = txtHead.Text
        rs(3) = txtAddress.Text
        rs.Update
        MsgBox "记录已经成功保存到数据库", vbInformation, "部门管理"
        Call fillList
        For i = 0 To Controls.Count - 1
            If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = False
        Next
        Call disallow
    End If
Case "delete"
    If rs.BOF = True Then
        MsgBox "没有任何部门档案记录，不能进行删除操作", vbInformation, "部门管理"
        Toolbar1.Buttons(3).Enabled = False
        Exit Sub
    End If
    rs.Delete
    rs.MoveNext
    If rs.EOF = True Then
        rs.Requery
        If rs.BOF = True Then
            MsgBox "现在已经没有任何部门档案记录", vbInformation, "部门管理"
            For i = 0 To Controls.Count - 1
                If TypeOf Controls(i) Is TextBox Then Controls(i).Text = ""
            Next
            Toolbar1.Buttons(3).Enabled = False
            List1.Clear
            Exit Sub
        End If
    End If
    Call fillList
Case "cancel"
    rs.CancelUpdate
    If rs.BOF = True Then
        For i = 0 To Controls.Count - 1
            If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = False
        Next
        Call disallow
        Exit Sub
    End If
    rs.MoveFirst
    Call display
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = False
    Next
    Call disallow
Case "update"
    If rs.BOF = True Then
        MsgBox "没有任何部门档案记录，不能进行更新操作", vbInformation, "部门管理"
        Toolbar1.Buttons(5).Enabled = False
        Exit Sub
    End If
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is TextBox Then Controls(i).Enabled = True
    Next
    Call allow
Case "exit"
    Unload Me
End Select
End Sub