modmain.bas

一套比较完整的VB开发的员工请假管理系统

Attribute VB_Name = "modMain"
Option Explicit
Public DBConnection As New ADODB.Connection     '定义一个连接
Public rctDepartList As New ADODB.Recordset     '定义一个记录集,表示部门表
Public rctEdulevel As New ADODB.Recordset       '定义一个记录集,表示学历表
Public rctEmployees As New ADODB.Recordset      '定义一个记录集,表示员工信息表
Public rctJobList As New ADODB.Recordset        '定义一个记录集,表示员工职务表
Public rctLeavelList As New ADODB.Recordset     '定义一个记录集,表示员工请假表
Public rctLeavelStatus As New ADODB.Recordset   '定义一个记录集,表示请假标志表
Public rctLeavelType As New ADODB.Recordset     '定义一个记录集,表示请假类型表
Public rctMarriageStatus As New ADODB.Recordset '定义一个记录集,表示婚姻状况表
Public rctPlitics As New ADODB.Recordset        '定义一个记录集,表示政治面貌表
Public rctTitelList As New ADODB.Recordset      '定义一个记录集,表示职称表
Public rctQueryEmployeesWithID As New ADODB.Recordset
Public rctQueryLeavelWithID As New ADODB.Recordset
Public rctOperatorList As New ADODB.Recordset
'Download by http://www.codefans.net

Public OperaterName As String                   '表示当前登陆的操作员名
Public strEmpFirstFieldValue As String          '员工表中当前指向的记录的第一个字段的值
Public strLvlFirstFieldValue As String          '员工请假表中当前指向的记录的第一个字段的值



Public Function ConnectDataBase() As Boolean
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\e26ygd\Emis\data\Employeemanage.mdb;Persist Security Info=False
Dim strDataPath As String

strDataPath = App.Path
If Right(strDataPath, 1) <> "\" Then
    strDataPath = strDataPath & "\"
End If
    On Error GoTo ConnectErr
        DBConnection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                        "Data Source=" & strDataPath & "data\Employeemanage.mdb" & ";" & _
                                        "Persist Security Info=False"
        DBConnection.ConnectionTimeout = 30
        DBConnection.Open
        ConnectDataBase = True
        Exit Function
                                        
ConnectErr:
        ConnectDataBase = False
        MsgBox "错误代码 :" & Err.Number & vbCrLf & _
                "错误描述 :" & Err.Description, vbCritical + vbOKOnly, "连接错误"
End Function

Public Function ExcuteSql(ByVal Recordsettest As ADODB.Recordset, ByVal strSql As String) As Boolean
    On Error GoTo ExcuteSqlError
    'Set Recordsettest = Nothing
    If Recordsettest.State = adStateOpen Then
       Recordsettest.Close
    End If
    'Recordset.CursorType = adOpenKeyset
    'Recordset.LockType = adLockOptimistic
    Call Recordsettest.Open(strSql, DBConnection, adOpenKeyset, adLockOptimistic, -1)
    ExcuteSql = True
    Exit Function
ExcuteSqlError:
    MsgBox "错误代码:" & Err.Number & vbCrLf & _
            "错误描述:" & Err.Description, vbCritical + vbOKOnly, "错误"
    ExcuteSql = False
End Function

Public Sub Main()
    Dim strSql  As String
    Dim OpenFlag As Boolean
    If ConnectDataBase = True Then                                          '连接数据库
        'strSql =
         OpenFlag = ExcuteSql(rctDepartList, "select * from DepartList") And _
                    ExcuteSql(rctEdulevel, "select * from Edulevel") And _
                    ExcuteSql(rctEmployees, "select * from Employees") And _
                    ExcuteSql(rctJobList, "select * from JobList") And _
                    ExcuteSql(rctLeavelList, "select * from LeavelList") And _
                    ExcuteSql(rctLeavelStatus, "select * from LeavelStatus") And _
                    ExcuteSql(rctLeavelType, "select * from LeavelType") And _
                    ExcuteSql(rctMarriageStatus, "select * from MarriageStatus") And _
                    ExcuteSql(rctPlitics, "select * from Plitics") And _
                    ExcuteSql(rctTitelList, "select * from TitelList")
                    
                                                                            '打开所有的记录集
        If OpenFlag = True Then
                    
               'frmMain.Show
               frmLogin.Show
        Else
            MsgBox "打开数据库有未知的错误"
        End If
        
       
    End If
End Sub