module1.bas

企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值

Attribute VB_Name = "mdlMain"
'公共变量
Public pInfoFolderPath '初始化文件夹路径
Public m_UN As String '用户名
Public m_UP As String '密码
Public m_UZ As String '组
Public pDBBkFldPath As String

'窗体封面
Public Const HWND_TOPMOST = -1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


Sub TextFocus(ctl As Control)
   On Error Resume Next
    ctl.SetFocus
    ctl.SelStart = 0
    ctl.SelLength = Len(ctl.Text)
    
End Sub

Sub TxtFocus(ctl As Control)
    ctl.SelStart = 0
    ctl.SelLength = Len(ctl.Text)
End Sub
'窗体一运行就在屏幕的中央
Sub CenterForm(frm As Form)
frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
End Sub





Sub Main()
    Dim fLogin As New frmLogin
   fLogin.Show vbModal
    If Not fLogin.bOk Then
        End
    End If
    Unload fLogin

    Load frmTP
End Sub

Public Function ExecuteSQL(ByVal sql As String, MsgString As String) _
   As ADODB.Recordset
'executes SQL and returns Recordset
   Dim cn As ADODB.Connection
   Dim rs As ADODB.Recordset
  Set cn = New ADODB.Connection
   Dim s() As String
   On Error GoTo ExecuteSQL_Error
    cn.ConnectionString = CS
    cn.Open
    s() = Split(sql)
    If InStr("INSERT,DELETE,UPDATE", UCase(s(0))) Then
       cn.Execute sql
       MsgString = s(0) & "ok"
    Else
        Set rs = New ADODB.Recordset
   
        rs.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
        
        MsgString = "查询到" & rs.RecordCount & " 条记录 "
    End If
    
    Set ExecuteSQL = rs
    
ExecuteSQL_Exit:
   Set rs = Nothing
   Set cn = Nothing
 Exit Function
   
   
ExecuteSQL_Error:
   MsgString = "查询错误: " & _
      Err.Description
   Resume ExecuteSQL_Exit
End Function

Public Function CS() As String
   'DSN
   'CS = "DSN=orsms;UID=;PWD=123"
    CS = "provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='123';data source=" & App.path & "\rsmsdb.mdb"
   'sql server
   'CS="driver={sql server};server=cj;uid=sa;pwd=;dababase=xx"
   '2、ACCESS
   ' cn.ConnectionString = "provider=Microsoft.Jet.OLEDB.3.51;Database Password= data source="
   'CS = "dsn=ocrms"

End Function

Public Sub showData(strSql As String, grid As Object)
  Dim i As Integer
  Dim rs As ADODB.Recordset
    Dim strMsg As String
    Set rs = ExecuteSQL(strSql, strMsg)
    With grid
      .Clear
      .Cols = rs.Fields.Count + 1
            
       '显示各字段
       For i = 1 To rs.Fields.Count
            .TextMatrix(0, i) = rs.Fields(i - 1).Name
       Next
      
        '设置各列的对齐方式
        For i = 0 To .Cols - 1
            .ColAlignment(i) = 0
        Next i
        
         .ColWidth(0) = 250
    End With
  
     '如果没有记录
    If rs.RecordCount = 0 Then
        grid.Rows = 1
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    '有记录
    rs.MoveFirst
   With grid
     .Rows = 1
     Do While Not rs.EOF
      .Rows = .Rows + 1
      For i = 1 To rs.Fields.Count
      If IsNull(rs.Fields(i - 1)) Then
      .TextMatrix(.Rows - 1, i) = ""
      Else
      .TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
      End If
      Next
      rs.MoveNext
    Loop
   End With
    grid.refresh
    rs.Close
    Set rs = Nothing
End Sub



 '判断窗体是否载入

Public Function dfIsFormLoad(ByVal strFormName As Variant) As Boolean

On Error GoTo ErrTrap

    Dim i As Integer

    dfIsFormLoad = False

    If strFormName = "" Then Exit Function

    For i = 0 To Forms.Count - 1

        If UCase$(Forms(i).Name) = UCase$(strFormName) Then

            dfIsFormLoad = True

            Exit Function

        Else

            dfIsFormLoad = False

        End If

    Next i

    Exit Function

ErrTrap:

    On Error GoTo 0

End Function
 
 '在MSFlexGrid控件中填入rs中的数据
Public Function FillData(rs As ADODB.Recordset, objGrid As Object)
     With objGrid
      .Clear
      .Cols = rs.Fields.Count + 1
       For i = 1 To rs.Fields.Count
            .TextMatrix(0, i) = rs.Fields(i - 1).Name
       Next
       
    
                
        '设置各列的对齐方式
        For i = 0 To .Cols - 1
            .ColAlignment(i) = 0
        Next i
        
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        If .Rows > 1 Then
        .RowSel = 1
        End If
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .ColWidth(0) = 250
        '.ColWidth(1) = 900
       ' .ColWidth(2) = 900
     End With
  
     '如果没有记录
    If rs.RecordCount = 0 Then
        objGrid.Rows = 1
        rs.Close
        Set rs = Nothing
        Exit Function
    End If
    '有记录
    rs.MoveFirst
   With objGrid
       .Rows = 1
     Do While Not rs.EOF
      .Rows = .Rows + 1
      For i = 1 To rs.Fields.Count
        If IsNull(rs.Fields(i - 1)) Then
          .TextMatrix(.Rows - 1, i) = ""
        Else
          .TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
        End If
      Next
      rs.MoveNext
    Loop
   End With
End Function