adoconn.bas

一个vb开发的人事信息管理软件,提供基本的人事信息管理

Attribute VB_Name = "AdoConn"
Option Explicit
Dim ConnectString As String  ''''定义连接数据库的连接串''''
Dim m_AdoConn As ADODB.Connection ''''定义连接数据库的连接对象'''''''''
Dim m_ResultSet As ADODB.Recordset ''''定义结果集''''''
'''用Ado技术连接数据库'''
Sub Main()
    
End Sub
'''''''打开指定的数据库''''''''''
'''''''DbName为要连接的数据库名称''''''''
Public Function ConnectToDatabase(DbName As String) As ADODB.Connection
    Dim m_Conn As ADODB.Connection
    Set m_Conn = New ADODB.Connection
    ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & Trim(DbName) & ";Persist Security Info=False"
    m_Conn.Open ConnectString
    Set ConnectToDatabase = m_Conn
End Function
'''''''定义执行SQL语句的函数,并返回结果集'''''''
Public Function ExecuteSQL(Sql As String, DbName As String) As ADODB.Recordset
       Dim sTokens() As String
       On Error GoTo ExecuteSQL_Error  '''''进行错误处理'''''''''''
       sTokens = Split(Sql)
       'MsgBox sTokens(0)
       ''''连接数据库''''''''''''''''
       
       Set m_AdoConn = ConnectToDatabase(DbName)
        ''''''''''''''''''''''''''''''''
      If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
         m_AdoConn.Execute Sql
         'MsgBox "fff"
      Else
         Set m_ResultSet = New ADODB.Recordset
         m_ResultSet.Open Trim$(Sql), m_AdoConn, adOpenKeyset, adLockOptimistic
         Set ExecuteSQL = m_ResultSet
         'MsgBox "dddd"
      End If
ExecuteSQL_Exit:
      
      Set m_ResultSet = Nothing
      Set m_AdoConn = Nothing
      Exit Function
   
ExecuteSQL_Error:
      
      Resume ExecuteSQL_Exit
End Function  '''''函数定义结束
''''''数据表中的某个字段值绑丁到控件combo1控件上
''''''Sql为sql查询语句''''''''
''''''DbName为数据库名称'''''''''''
''''''FieldName为字段值''''''''''''
''''''Cbo为控件名称''''''''''''''''
Public Sub BindToCombo(Sql As String, DbName As String, FieldName As String, Cbo As ComboBox)
      Dim m_Rst As New ADODB.Recordset
      Set m_Rst = ExecuteSQL(Sql, DbName)
      If m_Rst.RecordCount <> 0 Then
         'Cbo.Clear
         Do While Not m_Rst.EOF
             
             Cbo.AddItem (m_Rst(FieldName))
             m_Rst.MoveNext
         Loop
      End If
      Set m_Rst = Nothing
End Sub

''''''得到执行Sql语句后的记录个数''''''''''''''
Public Function getRstCount(Sql As String, DbName As String) As Integer
      Dim m_Rst As New ADODB.Recordset
      Set m_Rst = ExecuteSQL(Sql, DbName)
      If m_Rst.RecordCount <> 0 Then
         getRstCount = m_Rst(0)
      End If
End Function
''''''查询某个条件的记录是否存在'''''''''''''''''
Public Function isRecordExist(Sql As String, DbName As String) As Boolean
      Dim m_Rst As New ADODB.Recordset
      Set m_Rst = ExecuteSQL(Sql, DbName)
      'MsgBox m_Rst(0)
      If m_Rst(0) <> 0 Then
         isRecordExist = True
      Else
         isRecordExist = False
      End If
End Function
Public Sub TabToEnter(key As Integer)
      If key = 13 Then
         SendKeys "{Tab}"
      End If
End Sub
''''''将得到符合某个字段条件的字段值'''''''''''''''''''''''''
'''''***Sql为如'Select * From StuffInfo'的语句'''''''''''''
'''''***DbName为数据库名称'''''''''''''''''''''''''''''''''
'''''***FieldName为字段名称''''''''''''''''''''''''''''''''
'''''***sValue为字段值'''''''''''''''''''''''''''''''''''''
Public Function getFieldValue(Sql As String, DbName As String, FieldName As String, rFieldName As String, sValue As String) As String
      Dim m_Rst As New ADODB.Recordset
      Dim strSql As String
      Set m_Rst = ExecuteSQL(Sql, DbName)
      strSql = Sql & "  Where  " & Trim(FieldName) & "='" & Trim(sValue) & "'"
      If m_Rst.RecordCount <> 0 Then
         getFieldValue = m_Rst(rFieldName)
      Else
         getFieldValue = ""
      End If
End Function