宿舍管理

时　间:2020-06-27 13:09:21
作　者:雨泉   ID：39037  城市：金昌
摘　要:为方便宿舍管理，自己写了个  宿舍楼  住宿管理模块，方便宿舍调换、统计。
正　文:

为方便宿舍管理，自己写了个宿舍楼、住宿管理模块，方便宿舍调换、统计。

具体功能为：  信息录入    和   房间调换

Option Compare Database
Option Explicit
Private mclsSC姓名 As New SearchComboBox '声明一个组合框动态筛选类并将其实例化
Private mclsSC楼号 As New SearchComboBox '声明一个组合框动态筛选类并将其实例化
Private mclsSC单元号 As New SearchComboBox '声明一个组合框动态筛选类并将其实例化
Private mclsSC房号 As New SearchComboBox '声明一个组合框动态筛选类并将其实例化

Private Sub Form_Load()
    Dim ArrOpen    As Variant
    Dim strWhere      As String
    Dim strSQL        As String
    Dim cnn           As Object 'ADODB.Connection
    Dim rst           As Object 'ADODB.Recordset
    Dim rstTmp        As Object 'DAO.Recordset
    Dim blnTransBegin As Boolean
    Dim strBillNo1 As String
    Dim strBillNo2 As String
    Dim strBillNo3 As String
    Dim strMsg As String
      
      ArrOpen = Split(Me.OpenArgs, "|")
        Me![编号] = ArrOpen(0)
     
     mclsSC楼号.Init Combo:=Me.楼号2, _
                    SearchField:="名称", _
                    SQLSelect:="名称", _
                    SQLFROM:="基础信息表", _
                    SQLWhere:="类别='楼号'", _
                    SQLORDERBY:="名称"


     mclsSC单元号.Init Combo:=Me.单元号2, _
                    SearchField:="名称", _
                    SQLSelect:="名称", _
                    SQLFROM:="基础信息表", _
                    SQLWhere:="类别='单元号'", _
                    SQLORDERBY:="名称"

       mclsSC房号.Init Combo:=Me.房号2, _
                    SearchField:="名称", _
                    SQLSelect:="名称", _
                    SQLFROM:="基础信息表", _
                    SQLWhere:="类别='房号'", _
                    SQLORDERBY:="名称"
                    
        Set cnn = CurrentProject.Connection

       strSQL = "Select * FROM [后勤住宿管理] Where [编号]=" & SQLText(Me.编号)
        Set rst = OpenADORecordset(strSQL, , cnn)
         
         Me![姓名] = rst![姓名]
         Me![身份证号码] = rst![身份证号码]
         Me![所在部门] = rst![所在部门]
         Me![联系电话] = rst![联系电话]
         Me![制单人] = rst![制单人]
         Me![保存日期] = rst![保存日期]
         Me![楼号] = rst![楼号]
         Me![单元号] = rst![单元号]
         Me![房号] = rst![房号]
         Me![入住日期] = rst![入住日期]
          
       rst.Close
            
ExitHere:
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub

ErrorHandler:
    RDPErrorHandler Me.Name & ": Sub Form_Load()"
    Resume ExitHere
       
End Sub

Private Sub 保存_Click()

' On Error GoTo ErrorHandler
    Dim strWhere      As String
    Dim strSQL        As String
    Dim cnn           As Object 'ADODB.Connection
    Dim rst           As Object 'ADODB.Recordset
    Dim strSQL2        As String
    Dim cnn2           As Object 'ADODB.Connection
    Dim rst2           As Object 'ADODB.Recordset
    Dim rstTmp        As Object 'DAO.Recordset
    Dim blnTransBegin As Boolean
    Dim strBillNo1 As String
    Dim strBillNo2 As String
    Dim strBillNo3 As String
    Dim strMsg As String

    ' 检查文本有否输入
    If IsNull(Me.入住日期2) or Me.入住日期2 = "" Then
        MsgBox "请注意【变更日期】不能为空！"
        Me.入住日期2.SetFocus
      GoTo ExitHere
    
      End If
      
       ' 检查文本有否输入
    If IsNull(Me.楼号2) or Me.楼号2 = "" Then
        MsgBox "请注意【变更楼号】不能为空！"
        Me.楼号2.SetFocus
      GoTo ExitHere
    
      End If
      
        ' 检查文本有否输入
    If IsNull(Me.单元号2) or Me.单元号2 = "" Then
        MsgBox "请注意【变更单元号】不能为空！"
        Me.单元号2.SetFocus
      GoTo ExitHere
    
      End If

         ' 检查文本有否输入
    If IsNull(Me.房号2) or Me.房号2 = "" Then
        MsgBox "请注意【变更房号】不能为空！"
        Me.房号2.SetFocus
      GoTo ExitHere
    
      End If

    If Not CheckRequired(Me) Then Exit Sub
    If Not CheckTextLength(Me) Then Exit Sub

    Set cnn = CurrentProject.Connection

    strSQL = "Select * FROM [后勤住宿管理] Where [编号]=" & SQLText(Me.编号)
    Set rst = OpenADORecordset(strSQL, adLockOptimistic, cnn)
    If rst.EOF Then
        rst.AddNew
    End If
    
    rst![楼号] = Me![楼号2]
    rst![单元号] = Me![单元号2]
    rst![房号] = Me![房号2]
    rst![房间号] = Me![楼号2] & Me![单元号2] & Me![房号2]
    rst![入住日期] = Me![入住日期2]
    rst![制单人] = Forms!SysFrmMain.Nickname
    rst![保存日期] = Now
    
    rst.Update
    rst.Close

    If Not CheckRequired(Me) Then Exit Sub
    If Not CheckTextLength(Me) Then Exit Sub


    Set cnn2 = CurrentProject.Connection

    strSQL2 = "Select * FROM [后勤住宿管理变更] Where [ID]=" & Nz(Me![ID], 0)
    Set rst2 = OpenADORecordset(strSQL2, adLockOptimistic, cnn2)
    If rst2.EOF Then
        rst2.AddNew
    End If
    
    rst2![姓名] = Me![姓名]
    rst2![编号] = Me![编号]
    rst2![身份证号码] = Me![身份证号码]
    rst2![楼号] = Me![楼号]
    rst2![单元号] = Me![单元号]
    rst2![房号] = Me![房号]
    rst2![入住日期] = Me![入住日期]
    rst2![楼号2] = Me![楼号2]
    rst2![单元号2] = Me![单元号2]
    rst2![房号2] = Me![房号2]
    rst2![入住日期2] = Me![入住日期2]
    rst2![制单人] = Me![制单人]
    rst2![保存日期] = Me![保存日期]
    rst2![制单人2] = Forms!SysFrmMain.Nickname
    rst2![保存日期2] = Now
    
    rst2.Update
    rst2.Close
   
     MsgBoxEx LoadString("Saved Successfully."), vbInformation
     Me.Requery
     Form_frm后勤住宿_List.Requery
    
ExitHere:
    Set rst = Nothing
    Set cnn = Nothing
    Set rst2 = Nothing
    Set cnn2 = Nothing
    Exit Sub

ErrorHandler:
    If blnTransBegin Then
        cnn.RollbackTrans
        blnTransBegin = False
    End If
    RDPErrorHandler Me.Name & ": Sub btnSave_Click()"
    Resume ExitHere
End Sub

Private Sub 打印_Click()
  'On Error GoTo ErrorHandler
 
 If DCount("编号", "人资食宿离场表", "编号='" & Me.编号 & "'") = 0 Then
         MsgBox "请先保存，再点击 打印 按钮", vbCritical, "警告"
         Me.保存.SetFocus
         Exit Sub
     End If
 
   DoCmd.OpenReport "食宿安排通知单", acViewPreview, , "编号='" & Me.编号 & "'"
End Sub

Private Sub 单元号2_AfterUpdate()
    Me.房号2.SetFocus
End Sub


Private Sub 房号2_AfterUpdate()
   Me.入住日期2.SetFocus
End Sub

Private Sub 楼号2_AfterUpdate()
    Me.单元号2.SetFocus
End Sub

Private Sub 取消_Click()
   On Error Resume Next
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

Private Sub 入住日期2_AfterUpdate()
   If Me.入住日期2 > GetServerTime() Then
         MsgBox "入住日期不能大于  当前时间，系统以为您自动修改为当前日期！", vbCritical, "警告"
         Me.入住日期2.SetFocus
         Me.入住日期2 = GetServerTime()
         
         Exit Sub
     End If
   
   Me.保存.SetFocus
End Sub

Function GetServerTime() As Date  '获得SQL SERVER服务器时间
    Dim rst As Object
    Set rst = OpenADORecordset("Select GETDATE() AS sys_Sqlser_time") '主要为这句代码取得了SQL SERVER服务器时间
    GetServerTime = rst(0)
    rst.Close
    Set rst = Nothing
End Function
Private Sub 姓名_AfterUpdate()
   Me.身份证号码 = Me.姓名.Column(1) '2代表第3列，下同
   Me.所在部门 = Me.姓名.Column(2)
   Me.联系电话 = Me.姓名.Column(3)
   Me.楼号.SetFocus

End Sub