modexecutesql.bas

1、以DLL形式提供医生工作站 2、 根据【检查项目】

Attribute VB_Name = "modExecuteSql"
Option Explicit


'判断符合条件的记录是否存在  返回记录条数
Public Function GetRecordNumber(strSelectSql As String) As Integer
On Error GoTo ErrHandler
    If Len(Trim(strSelectSql)) <= 0 Then
        GetRecordNumber = 0
    End If
    
    Dim rsGet As New ADODB.Recordset
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    If myConn.State = 0 Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    rsGet.Open strSelectSql, myConn
    GetRecordNumber = rsGet.RecordCount
    
    rsGet.Close
    Set rsGet = Nothing
    myConn.Close
    Set myConn = Nothing
    
    Exit Function
ErrHandler:
    Dim strErr As String
    strErr = Err.Description
    GetRecordNumber = -1
    
End Function


    
'执行插入/更新等SQL语句
Public Function ExecuteInsert(strInsertSql As String) As Boolean
On Error GoTo ErrHandler
    If Len(Trim(strInsertSql)) <= 0 Then
        ExecuteInsert = False
    End If
    
    Dim rsCmd As New ADODB.Command
    rsCmd.CommandText = strInsertSql
    Dim myConn As New ADODB.Connection
    
    myConn.CursorLocation = adUseClient
    If myConn.State = 0 Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    rsCmd.ActiveConnection = myConn
    rsCmd.Execute
    myConn.Close
    Set myConn = Nothing
    
    ExecuteInsert = True
    
    Exit Function
ErrHandler:
    'Dim strerr As String
    'strerr = Err.Description
    ExecuteInsert = False
    ErrNumber = Err.Number
    MsgBox Err.Description, vbExclamation, "提示"
    
End Function

Public Function ExecuteNonQuery(strInsertSql As String) As Boolean
On Error GoTo ErrHandler
    If Len(Trim(strInsertSql)) <= 0 Then
        ExecuteNonQuery = False
    End If
    
    Dim rsCmd As New ADODB.Command
    rsCmd.CommandText = strInsertSql
    Dim myConn As New ADODB.Connection
    
    myConn.CursorLocation = adUseClient
    If myConn.State = 0 Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    rsCmd.ActiveConnection = myConn
    rsCmd.Execute
    myConn.Close
    Set myConn = Nothing
    
    ExecuteNonQuery = True
    
    Exit Function
ErrHandler:
    'Dim strerr As String
    'strerr = Err.Description
    ExecuteNonQuery = False
    MsgBox Err.Description, vbExclamation, "提示"
    
End Function