adoutils.cls

ADO Utility for Visual Basic 6.0

LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    Set rs = Nothing
End Function

Public Function GetCount(TableName As String, Optional WhereClause As String = "") As Long
    
    'RETURNS COUNT OF RECORDS WITHIN A TABLE, WITH OPTIONAL WHERE CLAUSE
    
    
    
    On Error GoTo LocalError
    Dim rs  As New ADODB.Recordset
    Dim SQL As String
    GetCount = 0
    If WhereClause <> "" Then
        SQL = "Select COUNT (*) FROM " & TableName & " WHERE " & WhereClause
    Else
        SQL = "Select COUNT (*) FROM " & TableName
    End If
    With rs
        .ActiveConnection = ConnectionString
        .CursorLocation = adUseClient
        .LockType = adLockReadOnly
        .CursorType = adOpenKeyset
        .Source = SQL
        .Open
        Set .ActiveConnection = Nothing
    End With
    GetCount = rs.Fields(0).Value
    Set rs = Nothing
Exit Function
LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    GetCount = -1
End Function

Public Function PutRS(rs As ADODB.Recordset) As Boolean
'USE THIS TO UPDATE A RECORDSET IN BATCH (TRANSACTIONAL) MODE
'IF CHANGES TO THE RECORDSET'S WERE MADE PRIOR TO THIS CALL
'THIS FUNCTION WILL COMMIT THEM TO THE UNDERYLING DATABASE


    On Error GoTo LocalError
    PutRS = False
    If EmptyRS(rs) Then
        Exit Function
    ElseIf rs.LockType = adLockReadOnly Then
        Exit Function
    Else
        Dim cn As New ADODB.Connection
        With cn
            .ConnectionString = ConnectionString
            .CursorLocation = adUseServer
            .Open
            .BeginTrans
        End With
        With rs
            .ActiveConnection = cn
            .UpdateBatch
            cn.CommitTrans
            Set .ActiveConnection = Nothing
        End With
        cn.Close
        Set cn = Nothing
    End If
    PutRS = True
Exit Function
LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    If cn.State = adStateOpen Then
        cn.RollbackTrans
        cn.Close
    End If
    Set cn = Nothing
    PutRS = False
End Function

Public Function sqlBoolean(TrueFalse As Boolean) As Integer
    'CONVERTS BIT RETURN VALUE FROM SQL SERVER
    
    'This is because SQL True = 1
    'VB True = -1
    sqlBoolean = TrueFalse
    If isSQL Then
        If TrueFalse = True Then sqlBoolean = TrueFalse * TrueFalse
    End If
End Function

Public Function sqlDate(ByVal vDate As Variant) As String

'THIS FUNCTION TAKES VALUES THAT ARE POSSIBLE
'DATES AND FORMATS THEM PROPERFOR INSERTION INTO
'DATABASE COLUMNS DEFINED AS DATES

    On Error GoTo LocalError
    'Remove all invalid characters
    vDate = Trim(CStr(vDate))
    vDate = Replace(vDate, "#", "")
    vDate = Replace(vDate, "'", "")
    vDate = Replace(vDate, Chr(34), "")
    '--------------------------------------
    'Convert the Date to a Double Precision
    '   for international compatability
    '--------------------------------------
    sqlDate = ""
    'First see in what format the data came
    ' Validate parameter
    If Not IsDate(vDate) Or IsNull(vDate) Then
        'Maybe it is a number
        If IsNumeric(vDate) Then
            vDate = CDate(vDate)
        End If
        If Not IsDate(vDate) Then
            'Still not a date
            Exit Function
        End If
    End If
    If isSQL Then
        'Format is MM/DD/??YY
        sqlDate = Format(vDate, "mm\/dd\/yyyy")
        sqlDate = "'" & sqlDate & "'"
    Else
        'Format by Regional Settings
        sqlDate = FormatDateTime(vDate, vbShortDate)
        sqlDate = "#" & sqlDate & "#"
    End If
Exit Function
LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    sqlDate = ""
End Function

Public Function sqlDateTime(ByVal vDate As Variant) As String

'THIS FUNCTION TAKES VALUES THAT ARE POSSIBLE
'DATES AND FORMATS THEM PROPERFOR INSERTION INTO
'DATABASE COLUMNS DEFINED AS DATE/TIMES

    On Error GoTo LocalError
    'Remove all invalid characters
    vDate = Trim(CStr(vDate))
    vDate = Replace(vDate, "#", "")
    vDate = Replace(vDate, "'", "")
    vDate = Replace(vDate, Chr(34), "")
    '--------------------------------------
    'Convert the Date to a Double Precision
    '   for international compatability
    '--------------------------------------
    sqlDateTime = ""
    'First see in what format the data came
    ' Validate parameter
    If Not IsDate(vDate) Or IsNull(vDate) Then
        'Maybe it is a number
        If IsNumeric(vDate) Then
            vDate = CDate(vDate)
        End If
        If Not IsDate(vDate) Then
            'Still not a date
            Exit Function
        End If
    End If
    If isSQL Then
        'Format is MM/DD/??YY HH:MM:SS
        sqlDateTime = Format(vDate, "mm\/dd\/yyyy hh\:mm\:ss")
        sqlDateTime = "'" & sqlDateTime & "'"
    Else
        'Format by Regional Settings
        sqlDateTime = FormatDateTime(vDate, vbShortDate) & " " & Format(vDate, "hh\:mm\:ss")
        sqlDateTime = "#" & sqlDateTime & "#"
    End If
Exit Function
LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    sqlDateTime = ""
End Function

Public Function sqlTime(ByVal vDate As Variant) As String
'THIS FUNCTION TAKES VALUES THAT ARE POSSIBLE
'DATES AND FORMATS THEM PROPERFOR INSERTION INTO
'DATABASE COLUMNS DEFINED AS TIME ONLY
    
    On Error GoTo LocalError
    'Remove all invalid characters
    vDate = Trim(CStr(vDate))
    vDate = Replace(vDate, "#", "")
    vDate = Replace(vDate, "'", "")
    vDate = Replace(vDate, Chr(34), "")
    '--------------------------------------
    'Convert the Date to a Double Precision
    '   for international compatability
    '--------------------------------------
    sqlTime = ""
    'First see in what format the data came
    ' Validate parameter
    If Not IsDate(vDate) Or IsNull(vDate) Then
        'Maybe it is a number
        If IsNumeric(vDate) Then
            vDate = CDate(vDate)
        End If
        If Not IsDate(vDate) Then
            'Still not a date
            Exit Function
        End If
    End If
    If isSQL Then
        'Format is MM/DD/??YY HH:MM:SS
        sqlTime = FormatDateTime(vDate, vbLongTime)
        sqlTime = "'" & sqlTime & "'"
    Else
        'Format by Regional Settings
        sqlTime = FormatDateTime(vDate, vbLongTime)
        sqlTime = "#" & sqlTime & "#"
    End If
Exit Function
LocalError:
    m_sLastError = Err.Number & " - " & Err.Description
    sqlTime = ""
End Function

Public Function sqlEncode(sqlValue) As String

    'IF A STRING VALUE IN AN SQL STATMENT HAS A ' CHARACTER,
    'USE THIS FUNCTION SO THE STRING CAN BE USED IN THE STATEMENT
     sqlEncode = Replace(sqlValue, "'", "''")
End Function


Public Property Get LastError() As String
    'IF AN ERROR OCCURS IN CALLING ONE OF THE FUNCTIONS IN THIS CLASS
    'READ THIS PROPERTY TO SEE WHAT THE ERROR WAS
 

    LastError = m_sLastError
    m_sLastError = ""
End Property



Public Function ExecuteID(SQL As String) As Long
'PURPOSE: RETURN VALUE OF IDENTITY COLUMN
'OF A NEWLY INSERTED RECORD


'SQL is a valid Insert statement.
'ConnetionString properyt has been set to a valid Connection String
'Tested on SQL7 as well as ACCESS 2000 using Jet4

On Error GoTo LocalError
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim AutoID As Long

With rs

'Prepare the RecordSet
.CursorLocation = adUseServer
 .CursorType = adOpenForwardOnly
 .LockType = adLockReadOnly
 .Source = "SELECT @@IDENTITY"
End With

With cn
 .ConnectionString = ConnectionString
 .CursorLocation = adUseServer
 .Open
 .BeginTrans
 .Execute SQL, , adCmdText + adExecuteNoRecords


        With rs

        .ActiveConnection = cn
        .Open , , , , adCmdText
        AutoID = rs(0).Value
        .Close
        End With
 .CommitTrans
 .Close
End With
Set rs = Nothing
Set cn = Nothing
 'If we get here ALL was Okay
 ExecuteID = AutoID
Exit Function


LocalError:
 m_sLastError = Err.Number & " - " & Err.Description

 ExecuteID = 0

End Function