VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cADO" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cADO Class Module ' ----------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Created On : August 22, 2001 ' Last Update : June 24, 2002 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : Microsoft Data Access Components (MDAC) 2.5 or better (http://www.microsoft.com/data/download.htm) ' * NOTE - This shows up in the VB references screen as "Microsoft ActiveX Data Objects 2.5 Library" ' ' Description : This class module gives you professional quality database functionality with minimal coding. ' It does all the work for you, all the error checking, and all the object validation. Using ' this class module will make your database code cleaner, more efficient, and less error-prone. ' ' IMPORTANT : Make sure that you use the connection object exposed by the "ConnectionObject" property if ' you need a connection to a database. The reason for this is you should only have one ' connection open through the life of your program (to conserve resources). Also, that ' connection should stay open the entired time so you don't have to keep opening and closing ' it (for performance reasons). ' ' NOTE : If you get a recordset back that contains NULL as the value returned from the database, the ' only way that I know of to check that value without getting an "Invalid use of NULL" error is ' by trimming the value and then tacking on a blank string and testing against a blank string: ' ' If Trim(rs("MyField") & "") = "" Then MsgBox "NULL or BLANK value returned" ' ' NOTE : If you are trying to retrieve a recordset with one variable, then return it by setting a return ' varialbe equal to the first, you CAN NOT close the recordset by calling the "Close" method ' of the ADODB.Recordset object. If you are not going to return the recordset, then you should ' close it. ' ' See Also : http://www.microsoft.com/data/ ' http://www.microsoft.com/data/ado/default.htm ' ' '------------------------------------------------------------------------------------------------------------- ' SIMPLE SQL STATEMENT EXECUTION SAMPLE VIA "ExecuteSQL" METHOD '------------------------------------------------------------------------------------------------------------- ' ' ' Dim ErrNum As Long ' Dim ErrDesc As String ' Dim strConStr As String ' Dim lngCount As Long ' Dim rs As ADODB.Recordset ' Dim ADO As clsADO ' Set ADO = New clsADO ' strConStr = "Driver={Microsoft Access Driver (*.mdb)};DBQ=C:\MyDB.mdb;UID=admin;PWD=admin;" ' If ADO.SetConnectionString(strConStr, ErrNum, ErrDesc) = False Then ' MsgBox "An error occured while trying to connect to the specified database:" & Chr(13) & Chr(13) & _ ' "Error Number = " & CStr(ErrNum) & Chr(13) & _ ' "Error Description = " & ErrDesc, vbOKOnly + vbExclamation, " DB Connection Error" ' GoTo CleanUp ' End If ' If ADO.ExecuteSQL("SELECT TOP 10 * FROM Users", , , , , , lngCount, ErrNum, ErrDesc, rs) = False Then ' MsgBox "An error occured while executing the SQL against the specified database:" & Chr(13) & Chr(13) & _ ' "Error Number = " & CStr(ErrNum) & Chr(13) & _ ' "Error Description = " & ErrDesc, vbOKOnly + vbExclamation, " DB Connection Error" ' GoTo CleanUp ' Else ' MsgBox CStr(lngCount) & " Records Returned", vbOKOnly + vbInformation, " " ' End If 'CleanUp: ' ADO.CleanupRecordset rs ' Set ADO = Nothing ' ' '------------------------------------------------------------------------------------------------------------- ' SAMPLE CODE DEMONSTRATING HOW TO CREATE A CONNECTION STRING, THEN QUERY INFORMATION FROM THE CONNECTION '------------------------------------------------------------------------------------------------------------- ' ' ' Dim ADO As cADO ' Dim RS As ADODB.Recordset ' Dim strConnStr As String ' Dim strReturn As String ' Dim lngErrNum As Long ' Dim strErrDesc As String ' ' Set ADO = New cADO ' ADO.CommandTimeout = 60 ' ADO.ConnectionTimeout = 60 ' ADO.UseTransactions = False ' If ADO.GenerateConnectionString(strConnStr, , , , , , , cp_SQL, , cn_TCP_IP, "BETASERVER", "TESTDB", , "sa", "", , , , , , lngErrNum, strErrDesc) = False Then ' MsgBox "The following error occured while generating the connection string:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " " ' GoTo CleanUp ' End If ' If ADO.SetConnectionString(strConnStr, lngErrNum, strErrDesc) = False Then ' MsgBox "The following error occured while connecting to the specified database:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " " ' GoTo CleanUp ' Else ' MsgBox "Specified Connection String:" & Chr(13) & ADO.ConnectionString(False) & Chr(13) & Chr(13) & "Real Connection String:" & Chr(13) & ADO.ConnectionString(True), vbOKOnly, " " ' End If ' ' If ADO.GetConnectionProperty("Database", strReturn, lngErrNum, strErrDesc) = True Then ' MsgBox "Database = " & strReturn, vbOKOnly, " " ' Else ' MsgBox "The following error occured while getting the connection property:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " " ' GoTo CleanUp ' End If ' ' If ADO.ExecuteSQL("SELECT * FROM Booms", , , , , , , lngErrNum, strErrDesc, RS, , 50, True) = False Then ' MsgBox "The following error occured while executing the SQL statement against the database:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " " ' GoTo CleanUp ' End If ' If Not RS Is Nothing Then ' Do While RS.EOF = False ' strReturn = strReturn & Trim(RS(2).Value & "") & Chr(13) ' RS.MoveNext ' Loop ' End If ' ' MsgBox strReturn, vbOKOnly, " " ' 'CleanUp: ' ADO.CleanupRecordset RS ' Set ADO = Nothing ' ' '------------------------------------------------------------------------------------------------------------- ' STORED PROCEDURE CALL SAMPLE VIA "ExecuteStoredProcEx" METHOD '------------------------------------------------------------------------------------------------------------- ' ' ' Dim rs As ADODB.Recordset ' Dim ADO As clsADO ' Dim strConStr As String ' Dim strSQL As String ' Dim strParams() As String ' Dim varValues() As Variant ' Dim lngCount As Long ' Dim ErrNum As Long ' Dim ErrDesc As String ' Set ADO = New clsADO ' strConStr = "Driver={SQL Server};server=255.255.255.255;UID=admin;PWD=admin;database=MyDB;" ' If ADO.SetConnectionString(strConStr, ErrNum, ErrDesc) = False Then ' MsgBox "An error occured while trying to connect to the specified database:" & Chr(13) & Chr(13) & _ ' "Error Number = " & CStr(ErrNum) & Chr(13) & _ ' "Error Description = " & ErrDesc, vbOKOnly + vbExclamation, " DB Connection Error" ' GoTo CleanUp ' End If ' strSQL = "CREATE PROCEDURE dbo.TestProc (@nValue1 int, @nResult int OUTPUT) AS SET @nResult = @nValue1 + 50" ' If ADO.ExecuteSQL(strSQL, , , , , , lngCount, ErrNum, ErrDesc, rs) = False Then ' MsgBox "An error occured while executing the SQL against the specified database:" & Chr(13) & Chr(13) & _ ' "Error Number = " & CStr(ErrNum) & Chr(13) & _ ' "Error Description = " & ErrDesc, vbOKOnly + vbExclamation, " DB Connection Error" ' GoTo CleanUp ' End If ' ReDim strParams(1) As String ' ReDim varValues(1) As Variant ' strParams(0) = "nValue1" ' strParams(1) = "nResult" ' varValues(0) = 1 ' varValues(1) = 0 ' If ADO.ExecuteStoredProcEx("TestProc", strParams, varValues, True, , , , , , ErrNum, ErrDesc) = False Then ' MsgBox "An error occured while executing the Stored Procedure against the specified database:" & Chr(13) & Chr(13) & _ ' "Error Number = " & CStr(ErrNum) & Chr(13) & _ ' "Error Description = " & ErrDesc, vbOKOnly + vbExclamation, " DB Connection Error" ' GoTo CleanUp ' Else ' MsgBox "Return = " & CStr(varValues(1)) ' End If 'CleanUp: ' ADO.CleanupRecordset rs ' Set ADO = Nothing ' ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyrightİ by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Enumeration - Connection Drivers ("DRIVER=XXXX;") Public Enum ConnDrivers cd_NotSpecified = 0 cd_Access = 1 cd_Excel = 2 cd_Excel_97 = 3 cd_Oracle = 4 cd_Paradox = 5 cd_SQL = 6 cd_Text = 7 cd_VFoxPro = 8 cd_VFoxPro_Cont = 9 End Enum ' Enumeration - Connection Providers ("PROVIDER=XXXX;") Public Enum ConnProviders cp_NotSpecified = 0 cp_Access = 1 cp_dBaseIII = 2 cp_dBaseIV = 3 cp_dBaseV = 4 cp_Excel = 5 cp_HTML = 6 cp_MsIndexingSrv = 7 cp_Oracle = 8 cp_SQL = 9 cp_Text = 10 End Enum ' Enumeration - Connection Network Protocols ("NETWORK LIBRARY=XXXX:") Public Enum ConnNetProtocols cn_NotSpecified = 0 cn_AppleTalk = 1 cn_BanyanVINES = 2 cn_IPX_SPX = 3 cn_Multiprotocol = 4 cn_NamedPipes = 5 cn_TCP_IP = 6 cn_VIA_Giganet = 7 End Enum ' Constants - Max Numbers Private Const MAX_DRIVERS = 9 Private Const MAX_PROVIDERS = 10 Private Const MAX_NET_PROTOCOLS = 7 ' Private variable declarations Private ConnIsolationLvl As IsolationLevelEnum Private ConnMode As ConnectModeEnum Private lngRecAffected As Long Private lngConnTimeout As Long Private lngCmdTimeout As Long Private strConnString As String Private blnUseTrans As Boolean Private strConnDriv() As String Private strConnProv() As String Private strConnNetProt() As String Private blnConnInfoBuilt As Boolean ' Private varaible declarations (with EVENTS) Private WithEvents conConnection As ADODB.Connection Attribute conConnection.VB_VarHelpID = -1 ' Event Declarations Public Event ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection) 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS EVENTS 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Sub Class_Initialize() On Error Resume Next ' Set the defaults (these are defined as the defaults in the MSDN for ADO) lngConnTimeout = 15 lngCmdTimeout = 30 ConnIsolationLvl = adXactCursorStability ConnMode = adModeUnknown End Sub Private Sub Class_Terminate() On Error Resume Next CleanupConnection conConnection End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CUSTOM CLASS EVENTS FIRED 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' This event fires whenever a SQL Statement or Stored Procedure in this class module finishes executing Private Sub conConnection_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection) On Error Resume Next lngRecAffected = RecordsAffected RaiseEvent ExecuteComplete(RecordsAffected, pError, adStatus, pCommand, pRecordset, pConnection) End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS PROPERTIES 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Sets the timeout (in seconds) for all queries run through a command object Public Property Get CommandTimeout() As Long CommandTimeout = lngCmdTimeout End Property Public Property Let CommandTimeout(ByVal NewValue As Long) If NewValue <> lngCmdTimeout Then lngCmdTimeout = NewValue CleanupConnection conConnection CheckConnection End If End Property 'Indicates the level of isolation for a Connection object: '--------------------------------------------------------- ' adXactUnspecified Indicates that the provider is using a different IsolationLevel than specified, but that the level cannot be determined. ' adXactChaos Default. Indicates that you cannot overwrite pending changes from more highly isolated transactions. ' adXactBrowse Indicates that from one transaction you can view uncommitted changes in other transactions. ' adXactReadUncommitted Same as adXactBrowse. ' adXactCursorStability Default. Indicates that from one transaction you can view changes in other transactions only after they've been committed. ' adXactReadCommitted Same as adXactCursorStability. ' adXactRepeatableRead Indicates that from one transaction you cannot see changes made in other transactions, but that requerying can bring new recordsets. ' adXactIsolated Indicates that transactions are conducted in isolation of other transactions. ' adXactSerializable Same as adXactIsolated. '--------------------------------------------------------- Public Property Get ConnectionIsolationLevel() As IsolationLevelEnum ConnectionIsolationLevel = ConnIsolationLvl End Property Public Property Let ConnectionIsolationLevel(ByVal NewValue As IsolationLevelEnum) If NewValue <> ConnIsolationLvl Then ConnIsolationLvl = NewValue CleanupConnection conConnection CheckConnection End If End Property 'Indicates the available permissions for modifying data in a Connection: '----------------------------------------------------------------------- ' adModeUnknown Default. Indicates that the permissions have not yet been set or cannot be determined. ' adModeRead Indicates read-only permissions. ' adModeWrite Indicates write-only permissions. ' adModeReadWrite Indicates read/write permissions. ' adModeShareDenyRead Prevents others from opening connection with read permissions. ' adModeShareDenyWrite Prevents others from opening connection with write permissions. ' adModeShareExclusive Prevents others from opening connection. ' adModeShareDenyNone Prevents others from opening connection with any permissions. '--------------------------------------------------------- Public Property Get ConnectionMode() As ConnectModeEnum ConnectionMode = ConnMode End Property Public Property Let ConnectionMode(ByVal NewValue As ConnectModeEnum) If NewValue <> ConnMode Then ConnMode = NewValue CleanupConnection conConnection CheckConnection End If End Property ' Returns a reference to the connection object that is being used by this class module. Exposing this ' interface allows the user to execute quick queries against it, or do custom things with ease. Public Property Get ConnectionObject() As ADODB.Connection On Error Resume Next Set ConnectionObject = conConnection End Property ' Returns the current connection string. To set this value, use the "SetConnectionString" method Public Property Get ConnectionString(Optional blnRealConnString As Boolean = False) As String If blnRealConnString = True Then If CheckConnection = False Then ConnectionString = "" Else ConnectionString = conConnection.ConnectionString End If Else ConnectionString = strConnString End If End Property ' Sets the timeout (in seconds) for all queries run through the connection object Public Property Get ConnectionTimeout() As Long ConnectionTimeout = lngConnTimeout End Property Public Property Let ConnectionTimeout(ByVal NewValue As Long) If NewValue <> lngConnTimeout Then lngConnTimeout = NewValue CleanupConnection conConnection CheckConnection End If End Property ' If this property is set to TRUE, then all queries are wrapped in an ADO transaction. This is a good idea for ' mission critical queries that can not be easily undone once executed. If any part of the query does not execute ' correctly, it will be automatically rolled back. If you would like to wrap several queries in one transaction, ' use the connection object interface "ConnectionObject" and call the "BeginTrans", "CommitTrans", and ' "RollbackTrans" methods. Public Property Get UseTransactions() As Boolean UseTransactions = blnUseTrans End Property Public Property Let UseTransactions(ByVal NewValue As Boolean) blnUseTrans = NewValue End Property 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS METHODS 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' CleanupCommand ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function properly cleans up an ADODB.Command object ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' objCommand Reference to the ADODB.Command object to clean up ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function CleanupCommand(ByRef objCommand As ADODB.Command) As Boolean On Error Resume Next If Not objCommand Is Nothing Then If Not objCommand.ActiveConnection Is Nothing Then Set objCommand.ActiveConnection = Nothing Set objCommand = Nothing Err.Clear End If CleanupCommand = True End Function '============================================================================================================= ' CleanupConnection ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function properly cleans up an ADODB.Connection object ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' objConnection Reference to the ADODB.Connection object to clean up ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function CleanupConnection(ByRef objConnection As ADODB.Connection) As Boolean On Error Resume Next If Not objConnection Is Nothing Then If objConnection.State <> adStateClosed Then objConnection.Close Set objConnection = Nothing Err.Clear End If CleanupConnection = True End Function '============================================================================================================= ' CleanupRecordset ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function properly cleans up an ADODB.Recordset object ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' objRecordset Reference to the ADODB.Recordset object to clean up ' blnCloseRS Optional. If set to TRUE, the ADODB.Recordset.Close method will be called. ' IMPORTANT - If you are trying to run a query with one Recordset variable, then pass ' the result back through a different Recordset variable by setting it EQUAL to the ' first... then you CLOSE the first Recordset, the second Recordset will be invalidated. ' Only close Recordset objects that you are not going to pass back through other variables. ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function CleanupRecordset(ByRef objRecordset As ADODB.Recordset, _ Optional ByVal blnCloseRS As Boolean = True) As Boolean On Error Resume Next If Not objRecordset Is Nothing Then Set objRecordset.ActiveConnection = Nothing If blnCloseRS = True Then If objRecordset.State <> adStateClosed Then objRecordset.Close Set objRecordset = Nothing Err.Clear End If CleanupRecordset = True End Function '============================================================================================================= ' ExecuteSQL ' ŻŻŻŻŻŻŻŻŻŻ ' This function executes the SQL statement, query, or stored procedure specified in the "strSQL" parameter ' and returns information about it's execution. ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strSQL String containing the SQL statement, query, or stored procedure to execute ' blnStoredProc Optional. If set to TRUE, this function assumes the "strSQL" parameter is a stored ' procedure call ' RsCursorLocation Optional. Sets the CursorLocation property of the "Return_Recordset" return parameter ' RsCursorType Optional. Sets the CursorType property of the "Return_Recordset" return parameter ' RsLockType Optional. Sets the LockType property of the "Return_Recordset" return parameter ' Return_Affected Optional. Returns how many records in the database were affected by the execution of ' the specified specified SQL string. ' Return_RecordCount Optional. If an ADODB.Recordset object was returned by the execution of the SQL string, ' this returns the number of records contained within the Recordset object. ' Return_ErrNum Optional. If an error occurs while executing this function, this returns the error number ' Return_ErrDesc Optional. If an error occurs while executing this function, this returns the error description ' Return_Recordset Optional. If an ADODB.Recordset object was returned by the execution of the SQL string, ' this is a reference to that recordset ' blnDisconnectTheRS Optional. If set to TRUE and a Recordset object is returned from the query, the Recordset ' is automatically disconnected before being returned. Otherwise, the Recordset object ' maintains it's connection and it is up to the caller to disconnect it (if applicable). ' lngRecordsetCacheSize Optional. Specifies the number of records from the returned Recordset object that are ' cached locally in memory. ADO's default is 1. ' blnDeleteRsIfBlank Optioanl. If set to TRUE and the specified SQL statement does not return any valid ' records, the ADODB.Recordset object that is returned via the "Return_Recordset" ' parameter is set to nothing. ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function ExecuteSQL(ByVal strSQL As String, _ Optional ByVal blnStoredProc As Boolean = False, _ Optional ByVal RsCursorLocation As ADODB.CursorLocationEnum = adUseClient, _ Optional ByVal RsCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _ Optional ByVal RsLockType As ADODB.LockTypeEnum = adLockPessimistic, _ Optional ByRef Return_Affected As Long, _ Optional ByRef Return_RecordCount As Long = -1, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String, _ Optional ByRef Return_Recordset As ADODB.Recordset, _ Optional ByVal blnDisconnectTheRS As Boolean = True, _ Optional ByVal lngRecordsetCacheSize As Long = 1, _ Optional ByVal blnDeleteRsIfBlank As Boolean = True) As Boolean On Error GoTo ErrorTrap ' Clear variables Err.Clear CleanupRecordset Return_Recordset lngRecAffected = -1 Return_Affected = -1 Return_ErrNum = -1 Return_ErrDesc = "" ' Check the SQL statement strSQL = Trim(strSQL) If strSQL = "" Then Return_ErrNum = -1 Return_ErrDesc = "No SQL statement specified to execute" Exit Function ' Check the connection to the database ElseIf CheckConnection(Return_ErrNum, Return_ErrDesc) = False Then Exit Function End If ' Execute the stored procedure If blnStoredProc = True Then ' If you're executing a stored procedure with NO PARAMETERS, and you include the open/close ' parentheses "()", it will give you an error... so take them off here If Right(strSQL, 2) = "()" Then strSQL = Left(strSQL, Len(strSQL) - 2) ' Setup the recordset to use Set Return_Recordset = New ADODB.Recordset Return_Recordset.CursorLocation = RsCursorLocation Return_Recordset.CursorType = RsCursorType Return_Recordset.LockType = RsLockType Return_Recordset.CacheSize = lngRecordsetCacheSize ' If user specified to use transactions, start the transaction If blnUseTrans = True Then conConnection.BeginTrans ' Execute Return_Recordset.open strSQL, conConnection, , , adCmdStoredProc ' If user specified to use transactions, commit the transaction If blnUseTrans = True Then conConnection.CommitTrans ' If the user specified to do so, disconnect the RS from the database If blnDisconnectTheRS = True Then Set Return_Recordset.ActiveConnection = Nothing ' Check if the recordset returned is valid. If IsRecordsetValid(Return_Recordset, True, blnDeleteRsIfBlank) = True Then ' If the user wants the record count back, loop through it and count the records (this works on all cursor types and locations) If Return_RecordCount <> -1 Then Return_RecordCount = 0 Return_Recordset.MoveFirst Do While Return_Recordset.EOF = False Return_RecordCount = Return_RecordCount + 1 Return_Recordset.MoveNext Loop Return_Recordset.MoveFirst End If Else Return_RecordCount = 0 End If ' Return the number of records affected Return_Affected = lngRecAffected ' Execute the SQL statement Else ' If the SQL statement is a SELECT statement, use the ADODB.Recordset object If UCase(Left(strSQL, 7)) = "SELECT " Then ' Setup the recordset to use Set Return_Recordset = New ADODB.Recordset Return_Recordset.CursorLocation = RsCursorLocation Return_Recordset.CursorType = RsCursorType Return_Recordset.LockType = RsLockType Return_Recordset.CacheSize = lngRecordsetCacheSize ' If user specified to use transactions, start the transaction If blnUseTrans = True Then conConnection.BeginTrans ' Execute Return_Recordset.open strSQL, conConnection, , , adCmdText ' If user specified to use transactions, commit the transaction If blnUseTrans = True Then conConnection.CommitTrans ' If the user specified to do so, disconnect the RS from the database If blnDisconnectTheRS = True Then Set Return_Recordset.ActiveConnection = Nothing ' Check if the recordset returned is valid. If IsRecordsetValid(Return_Recordset, True, blnDeleteRsIfBlank) = True Then ' If the user wants the record count back, loop through it and count the records (this works on all cursor types and locations) If Return_RecordCount <> -1 Then Return_RecordCount = 0 Return_Recordset.MoveFirst Do While Return_Recordset.EOF = False Return_RecordCount = Return_RecordCount + 1 Return_Recordset.MoveNext Loop Return_Recordset.MoveFirst End If Else Return_RecordCount = 0 End If ' Nothing affected when executing a SELECT statement Return_Affected = 0 ' The SQL statement is not a SELECT statement, so use the Connection object in order to get back how many records were affected Else ' If user specified to use transactions, start the transaction If blnUseTrans = True Then conConnection.BeginTrans ' Execute conConnection.Execute strSQL, Return_Affected, adCmdText ' If user specified to use transactions, commit the transaction If blnUseTrans = True Then conConnection.CommitTrans ' No records are returned on a non-SELECT statement Return_RecordCount = 0 End If End If ExecuteSQL = True Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If blnUseTrans = True Then conConnection.RollbackTrans 'Rollback the transaction CleanupRecordset Return_Recordset End Function '============================================================================================================= ' ExecuteStoredProc ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function executes the stored procedure specified in the "strStoredProcName" parameter and returns ' information about it's execution. This function uses the ADODB.Connection object and does NOT return ' OUTPUT parameters from stored procedures. ' ' * IMPORTANT - You must pass the parameter values in the order they are declared in the stored procedure ' * IMPORTANT - Make sure you do NOT assign a value to parameters you are omitting (like optional parameters, ' or parameters that have default values. By not assigning a value to a VARIANT data type, ' it's value will be EMPTY. This is what should be passed. You can assign EMPTY, but don't ' assign anything else.) ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strStoredProcName Specifies the name of the stored procedure to execute ' blnParameterIsString Points to an array of BOOLEAN values that specify if the parameter is a STRING value. ' STRING values need to be wrapped in single quote (') marks. ' varParameterValues Points to an array of VARIANT values that represent the values of the parameters ' to be passed to the stored procedure. These should be passed IN THE ORDER THEY ARE ' DECLARED IN THE STORED PROCEDURE. ' blnParametersPassed If this is set to TRUE, it indicates that the function should look to the ' "blnParameterIsString" and "varParameterValues" parameters for the parameters to pass ' to the specified stored procedure. If this is set to FALSE, this function ignores ' parameter information passed. ' RsCursorLocation Optional. Sets the CursorLocation property of the "Return_Recordset" return parameter ' RsCursorType Optional. Sets the CursorType property of the "Return_Recordset" return parameter ' RsLockType Optional. Sets the LockType property of the "Return_Recordset" return parameter ' Return_Affected Optional. Returns how many records in the database were affected by the execution of ' the stored proc ' Return_RecordCount Optional. If an ADODB.Recordset object was returned by the execution of the stored ' proc, this returns the number of records contained within the Recordset object. ' Return_ErrNum Optional. If an error occurs while executing this function, this returns the error number ' Return_ErrDesc Optional. If an error occurs while executing this function, this returns the error description ' Return_Recordset Optional. If an ADODB.Recordset object was returned by the execution of the stored ' proc, this is a reference to that recordset ' blnDisconnectTheRS Optional. If set to TRUE and a Recordset object is returned from the query, the Recordset ' is automatically disconnected before being returned. Otherwise, the Recordset object ' maintains it's connection and it is up to the caller to disconnect it (if applicable). ' lngRecordsetCacheSize Optional. Specifies the number of records from the returned Recordset object that are ' cached locally in memory. ADO's default is 1. ' blnDeleteRsIfBlank Optioanl. If set to TRUE and the specified SQL statement does not return any valid ' records, the ADODB.Recordset object that is returned via the "Return_Recordset" ' parameter is set to nothing. ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function ExecuteStoredProc(ByVal strStoredProcName As String, _ ByRef blnParameterIsString() As Boolean, _ ByRef varParameterValues() As Variant, _ ByVal blnParametersPassed As Boolean, _ Optional ByVal RsCursorLocation As ADODB.CursorLocationEnum = adUseClient, _ Optional ByVal RsCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _ Optional ByVal RsLockType As ADODB.LockTypeEnum = adLockPessimistic, _ Optional ByRef Return_Affected As Long, _ Optional ByRef Return_RecordCount As Long = -1, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String, _ Optional ByRef Return_Recordset As ADODB.Recordset, _ Optional ByVal blnDisconnectTheRS As Boolean = True, _ Optional ByVal lngRecordsetCacheSize As Long = 1, _ Optional ByVal blnDeleteRsIfBlank As Boolean = True) As Boolean On Error GoTo ErrorTrap Dim BoolUBound As Long Dim BoolLBound As Long Dim ValueUBound As Long Dim ValueLBound As Long Dim lngCounter As Long Dim strSQL As String ' Clear variables Err.Clear CleanupRecordset Return_Recordset lngRecAffected = -1 Return_Affected = -1 Return_ErrNum = -1 Return_ErrDesc = "" ' Check the SQL statement strStoredProcName = Trim(strStoredProcName) If strStoredProcName = "" Then Return_ErrNum = -1 Return_ErrDesc = "No stored procedure name specified to execute" Exit Function ' Check the connection to the database ElseIf CheckConnection(Return_ErrNum, Return_ErrDesc) = False Then Exit Function ' Check if there are parameters passed ElseIf blnParametersPassed = True Then If ArrayIsEmpty_BLN(blnParameterIsString, BoolLBound, BoolUBound) = True Or _ ArrayIsEmpty_VAR(varParameterValues, ValueLBound, ValueUBound) = True Then Return_ErrNum = -1 Return_ErrDesc = "Parameter count passed to 'ExecuteStoredProc' is greater than zero, but the parameters passed were invalid or missing" Exit Function ElseIf (BoolLBound <> ValueLBound) Or (BoolUBound <> ValueUBound) Then Return_ErrNum = -1 Return_ErrDesc = "The number of parameter names don't match the number of parameter values passed to the 'ExecuteStoredProc' method" Exit Function End If End If ' Create the Stored Procedure string strSQL = strStoredProcName If blnParametersPassed = True Then strSQL = strSQL & " (" For lngCounter = BoolLBound To BoolUBound If blnParameterIsString(lngCounter) = True Then If IsEmpty(varParameterValues(lngCounter)) = True Then strSQL = strSQL & ", " Else strSQL = strSQL & "'" & ReplaceChar(CStr(varParameterValues(lngCounter)), "'", "''") & "', " End If Else If IsEmpty(varParameterValues(lngCounter)) = True Then strSQL = strSQL & ", " Else strSQL = strSQL & ReplaceChar(CStr(varParameterValues(lngCounter)), "'", "''") & ", " End If End If Next strSQL = Trim(strSQL) If Right(strSQL, 1) = "," Then strSQL = Left(strSQL, Len(strSQL) - 1) strSQL = strSQL & ")" End If ' Create the recordset to use Set Return_Recordset = New ADODB.Recordset Return_Recordset.CursorLocation = RsCursorLocation Return_Recordset.CursorType = RsCursorType Return_Recordset.LockType = RsLockType Return_Recordset.CacheSize = lngRecordsetCacheSize ' If user specified to use transactions, start the transaction If blnUseTrans = True Then conConnection.BeginTrans ' Execute Return_Recordset.open strSQL, conConnection, , , adCmdStoredProc ' If user specified to use transactions, commit the transaction If blnUseTrans = True Then conConnection.CommitTrans ' If the user specified to do so, disconnect the RS from the database If blnDisconnectTheRS = True Then Set Return_Recordset.ActiveConnection = Nothing ' Check if the return recordset is valid If IsRecordsetValid(Return_Recordset, True, blnDeleteRsIfBlank) = True Then ' If the user wants the record count back, loop through it and count the records (this works on all cursor types and locations) If Return_RecordCount <> -1 Then Return_RecordCount = 0 Return_Recordset.MoveFirst Do While Return_Recordset.EOF = False Return_RecordCount = Return_RecordCount + 1 Return_Recordset.MoveNext Loop Return_Recordset.MoveFirst End If Else Return_RecordCount = 0 End If Return_Affected = lngRecAffected ExecuteStoredProc = True CleanUp: Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If blnUseTrans = True Then conConnection.RollbackTrans ' Rollback the transaction CleanupRecordset Return_Recordset GoTo CleanUp End Function '============================================================================================================= ' ExecuteStoredProcEx ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function executes the stored procedure specified in the "strStoredProcName" parameter and returns ' information about it's execution. This function uses the ADODB.Command object and returns OUTPUT parameters. ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strStoredProcName Specifies the name of the stored procedure to execute ' strParameterNames Points to an array of STRING values that specify if the names of the parameters to be ' passed to the stored procedure specified. These have to be passed in the same order ' as the "varParameterValues" parameter so names and values match up. ' varParameterValues Points to an array of VARIANT values that represent the values of the parameters ' to be passed to the stored procedure. These have to be passed in the same order ' as the "strParameterNames" parameter so names and values match up. ' NOTE : You can set the value of a parameter to "NULL" (without the quotes) and the ' database will recognize that as a NULL value. ' blnParametersPassed If this is set to TRUE, it indicates that the function should look to the ' "blnParameterIsString" and "varParameterValues" parameters for the parameters to pass ' to the specified stored procedure. If this is set to FALSE, this function ignores ' parameter information passed. ' RsCursorLocation Optional. Sets the CursorLocation property of the "Return_Recordset" return parameter ' RsCursorType Optional. Sets the CursorType property of the "Return_Recordset" return parameter ' RsLockType Optional. Sets the LockType property of the "Return_Recordset" return parameter ' Return_Affected Optional. Returns how many records in the database were affected by the execution of the stored proc ' Return_RecordCount Optional. If an ADODB.Recordset object was returned by the execution of the stored proc, this ' returns the number of records contained within the Recordset object. ' Return_ErrNum Optional. If an error occurs while executing this function, this returns the error number ' Return_ErrDesc Optional. If an error occurs while executing this function, this returns the error description ' Return_Recordset Optional. If an ADODB.Recordset object was returned by the execution of the stored proc, this is ' a reference to that recordset ' blnDisconnectTheRS Optional. If set to TRUE and a Recordset object is returned from the query, the Recordset ' is automatically disconnected before being returned. Otherwise, the Recordset object ' maintains it's connection and it is up to the caller to disconnect it (if applicable). ' lngRecordsetCacheSize Optional. Specifies the number of records from the returned Recordset object that are ' cached locally in memory. ADO's default is 1. ' blnDeleteRsIfBlank Optioanl. If set to TRUE and the specified SQL statement does not return any valid ' records, the ADODB.Recordset object that is returned via the "Return_Recordset" ' parameter is set to nothing. ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function ExecuteStoredProcEx(ByVal strStoredProcName As String, _ ByRef strParameterNames() As String, _ ByRef varParameterValues() As Variant, _ ByVal blnParametersPassed As Boolean, _ Optional ByVal RsCursorLocation As ADODB.CursorLocationEnum = adUseClient, _ Optional ByVal RsCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _ Optional ByVal RsLockType As ADODB.LockTypeEnum = adLockPessimistic, _ Optional ByRef Return_Affected As Long, _ Optional ByRef Return_RecordCount As Long = -1, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String, _ Optional ByRef Return_Recordset As ADODB.Recordset, _ Optional ByVal blnDisconnectTheRS As Boolean = True, _ Optional ByVal lngRecordsetCacheSize As Long = 1, _ Optional ByVal blnDeleteRsIfBlank As Boolean = True) As Boolean On Error GoTo ErrorTrap Dim objCommand As ADODB.Command Dim NameUBound As Long Dim NameLBound As Long Dim ValueUBound As Long Dim ValueLBound As Long Dim blnErrorParm As Boolean Dim strErrorParm As String Dim lngCounter As Long ' Clear variables Err.Clear CleanupRecordset Return_Recordset lngRecAffected = -1 Return_Affected = -1 Return_ErrNum = -1 Return_ErrDesc = "" ' Check the SQL statement strStoredProcName = Trim(strStoredProcName) If strStoredProcName = "" Then Return_ErrNum = -1 Return_ErrDesc = "No stored procedure name specified to execute" Exit Function ' Check the connection to the database ElseIf CheckConnection(Return_ErrNum, Return_ErrDesc) = False Then Exit Function ' Check if there are parameters passed ElseIf blnParametersPassed = True Then If ArrayIsEmpty_STR(strParameterNames, NameLBound, NameUBound) = True Or _ ArrayIsEmpty_VAR(varParameterValues, ValueLBound, ValueUBound) = True Then Return_ErrNum = -1 Return_ErrDesc = "Parameter count passed to 'ExecuteStoredProcEx' is greater than zero, but the parameters passed were invalid or missing" Exit Function ElseIf (NameLBound <> ValueLBound) Or (NameUBound <> ValueUBound) Then Return_ErrNum = -1 Return_ErrDesc = "The number of parameter names don't match the number of parameter values passed to the 'ExecuteStoredProcEx' method" Exit Function Else For lngCounter = NameLBound To NameUBound strParameterNames(lngCounter) = Trim(strParameterNames(lngCounter)) If strParameterNames(lngCounter) <> "" Then If Left(strParameterNames(lngCounter), 1) <> "@" Then strParameterNames(lngCounter) = "@" & strParameterNames(lngCounter) End If Next End If End If ' Create the command object to use Set objCommand = New ADODB.Command Set objCommand.ActiveConnection = conConnection objCommand.CommandTimeout = lngCmdTimeout objCommand.CommandType = adCmdStoredProc objCommand.CommandText = strStoredProcName objCommand.Parameters.Refresh ' Loop through the parameters passed and If blnParametersPassed = True Then blnErrorParm = True For lngCounter = NameLBound To NameUBound strErrorParm = strParameterNames(lngCounter) If strParameterNames(lngCounter) <> "" Then If UCase(strParameterNames(lngCounter)) <> "@RETURN_VALUE" Then objCommand(strParameterNames(lngCounter)) = varParameterValues(lngCounter) End If End If Next blnErrorParm = False End If ' Create the recordset to use Set Return_Recordset = New ADODB.Recordset Return_Recordset.CursorLocation = RsCursorLocation Return_Recordset.CursorType = RsCursorType Return_Recordset.LockType = RsLockType Return_Recordset.CacheSize = lngRecordsetCacheSize ' If user specified to use transactions, start the transaction If blnUseTrans = True Then conConnection.BeginTrans ' Execute Return_Recordset.open objCommand, , , , adCmdStoredProc ' If user specified to use transactions, commit the transaction If blnUseTrans = True Then conConnection.CommitTrans ' Function succeeded Return_Affected = lngRecAffected ExecuteStoredProcEx = True ' Return the stored parameter OUTPUT parameters If blnParametersPassed = True Then AssignReturnValue strParameterNames, varParameterValues, objCommand, NameLBound, NameUBound ' Check if the return recordset is valid If Not Return_Recordset Is Nothing Then ' If the user specified to do so, disconnect the RS from the database If blnDisconnectTheRS = True Then Set Return_Recordset.ActiveConnection = Nothing If Return_Recordset.State <> adStateClosed Then If Return_Recordset.BOF = False Or Return_Recordset.EOF = False Then ' If the user wants the record count back, loop through it and count the records (this works on all cursor types and locations) If Return_RecordCount <> -1 Then Return_RecordCount = 0 Return_Recordset.MoveFirst Do While Return_Recordset.EOF = False Return_RecordCount = Return_RecordCount + 1 Return_Recordset.MoveNext Loop Return_Recordset.MoveFirst Else Return_RecordCount = 0 If blnDeleteRsIfBlank = True Then Return_Recordset.Close Set Return_Recordset = Nothing End If End If Else Return_RecordCount = 0 If blnDeleteRsIfBlank = True Then Return_Recordset.Close Set Return_Recordset = Nothing End If End If Else Return_RecordCount = 0 If blnDeleteRsIfBlank = True Then Set Return_Recordset = Nothing End If Else Return_RecordCount = 0 End If CleanUp: CleanupCommand objCommand Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If blnErrorParm = True Then Return_ErrDesc = "Parameter = " & strErrorParm & " : " & Return_ErrDesc If blnParametersPassed = True Then AssignReturnValue strParameterNames, varParameterValues, objCommand, NameLBound, NameUBound If blnUseTrans = True Then conConnection.RollbackTrans ' Rollback the transaction CleanupRecordset Return_Recordset GoTo CleanUp End Function '============================================================================================================= ' GetRecordCount ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function returns the number of records in the specified ADODB.Recordset object. ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' rsRecordset Reference to the ADODB.Recordset to count the records for ' Return_RecordCount Returns the number of records in the specified recordset if any exist. ' Return_ErrNum Optional. If an error occurs while trying to get the record count, this returns the error number ' Return_ErrDesc Optional. If an error occurs while trying to get the record count, this returns the error description ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function GetRecordCount(ByRef rsRecordSet As ADODB.Recordset, _ ByRef Return_RecordCount As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error Resume Next Dim blnReturn As Boolean ' Clear variables Err.Clear Return_RecordCount = -1 Return_ErrNum = 0 Return_ErrDesc = "" ' Validate parameters If IsRecordsetValid(rsRecordSet) = False Then Return_ErrNum = -1 Return_ErrDesc = "Invalid ADODB.Recordset object passed to the GetRecordCount function" Exit Function Else Return_RecordCount = 0 End If ' Loop through the recordset and get the count ' (This works for any type of recordset because they all support MoveNext and MoveFirst) rsRecordSet.MoveFirst Do While rsRecordSet.EOF = False Return_RecordCount = Return_RecordCount + 1 rsRecordSet.MoveNext Loop rsRecordSet.MoveFirst ' Got the count GetRecordCount = True End Function '============================================================================================================= ' IsRecordsetValid ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function tests the specified ADODB.Recordset object and returns whether it is valid or not ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' rsRecordset Reference to the ADODB.Recordset object to test ' blnCheck_BOF_EOF Optional. If set to TRUE and the ADODB.Recordset.BOF = True and ADODB.Recordset.EOF = True, ' then the recordset will be returned as INVALID. It's not really invalid, BOF/EOF simply ' means the recordset contains no records. However, in most cases, that makes it invalid. ' blnDeleteIfInvalid Optional. If this is set to TRUE and the ADODB.Recordset object is determined to be INVALID, ' then the recordset is cleaned up and destroyed. ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if the recordset object specified is valid ' Returns FALSE if the recordset object specified is INVALID '============================================================================================================= Public Function IsRecordsetValid(ByRef rsRecordSet As ADODB.Recordset, _ Optional ByVal blnCheck_BOF_EOF As Boolean = True, _ Optional ByVal blnDeleteIfInvalid As Boolean = False) As Boolean On Error Resume Next ' Recordset is invalid if it's NOTHING If rsRecordSet Is Nothing Then If blnDeleteIfInvalid = True Then CleanupRecordset rsRecordSet ' Recordset is invalid if it's state is CLOSED ElseIf rsRecordSet.State = adStateClosed Then If blnDeleteIfInvalid = True Then CleanupRecordset rsRecordSet ' If a Recordset has it's "BOF" and "EOF" properties both set to TRUE, there's nothing in the ' recordset, but it's still valid... so if the user wants to check for it, do so here. ElseIf rsRecordSet.BOF = True And rsRecordSet.EOF = True Then If blnCheck_BOF_EOF = True Then If blnDeleteIfInvalid = True Then CleanupRecordset rsRecordSet Else ' Recordset is VALID! IsRecordsetValid = True End If Else ' Recordset is VALID! IsRecordsetValid = True End If End Function '============================================================================================================= ' GetConnectionProperty ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function searches the current ADODB.Connection.Properties collection and the extended properties for ' the specified parameter and if found, returns it's values. If the parameter is not found, this function ' returns false with an error stating it wasn't found. ' ' NOTE: The name of the property you provide the connection object (via the connection string or otherwise) ' may change after the connection is opened. For example, "SERVER" may be changed to "DATA SOURCE NAME", ' and "DATABASE" may be changed to "CURRENT CATALOG", etc. ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strPropertyName Specifies the name of the parameter to retrieve the value for ' Return_PropertyValue Returns the value of the specified parameter if found ' Return_ErrNum Optional. If an error occurs, this parameter returns the error number ' Return_ErrDesc Optional. If an error occurs, this parameter returns the error description ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function GetConnectionProperty(ByVal strPropertyName As String, _ ByRef Return_PropertyValue As Variant, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim lngCounter As Long Dim blnFoundIt As Boolean Dim strExtProp As String Dim lngStart As Long Dim lngEnd As Long Dim strName As String Dim vntValue As Variant ' Clear variables Return_PropertyValue = Empty Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure there's a valid connection If CheckConnection(Return_ErrNum, Return_ErrDesc) = False Then Exit Function ' Loop through the properties of the current connection and see if the specified property exists strPropertyName = UCase(strPropertyName) If conConnection.properties.Count > 0 Then For lngCounter = 0 To conConnection.properties.Count - 1 strName = UCase(conConnection.properties.item(lngCounter).Name) vntValue = conConnection.properties.item(lngCounter).Value Debug.Print strName & " = " & Trim(vntValue & "") If strName = strPropertyName Then blnFoundIt = True Return_PropertyValue = vntValue Exit For ElseIf strName = "EXTENDED PROPERTIES" Then strExtProp = CStr(vntValue) End If Next End If ' Check the extended properties for the property we're looking for If blnFoundIt = False And strExtProp <> "" Then lngStart = InStr(1, strExtProp, strPropertyName & "=", vbTextCompare) If lngStart > 0 Then blnFoundIt = True lngStart = lngStart + Len(strPropertyName & "=") lngEnd = InStr(lngStart, strExtProp, ";", vbTextCompare) If lngEnd < 1 Then lngEnd = Len(strExtProp) - lngStart Else lngEnd = lngEnd - lngStart End If Return_PropertyValue = Mid(strExtProp, lngStart, lngEnd) End If End If ' If we didn't find it, then return that we didn't If blnFoundIt = False Then Return_ErrNum = -1 Return_ErrDesc = "The connection property '" & strPropertyName & "' was not found in the current connection." Else GetConnectionProperty = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' GenerateConnectionString ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function takes the specified parameters and creates a valid connection string for you that can be used ' via the ADODB.Connection.Open method or the cADO.SetConnectionString method. ' ' NOTE: The "ConnectionProvider" parameter is prefered over "ConnectionDriver" parameter if both are specified ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' Return_ConnectionString Returns the connection string that you can use via the "SetConnectionString" method ' based on the parameters you specify. ' blnRemoteServer Optional. If set to TRUE, this function will generate a remote server connection string. ' strRemoteServerURL Optional. If "blnRemoteServer" is set to TRUE, you *MUST* specify the remote URl here. ' lngRemoteServerTimeout Optional. If "blnRemoteServer" is set to TRUE, you can set the remote server timeout ' (in milliseconds) here. Leave at the default of -1 to not specify this. ' strRemoteServerProvider Optional. If "blnRemoteServer" is set to TRUE, you can specify the data provider here. ' blnDataShape Optional. If set to TRUE (and blnRemoteServer is set to FALSE), this function will ' generate a data shaped connection string. ' strDataShapeProvider Optional. If "blnDataShape" is set to TRUE, you can specify the data provider here, ' or you can use the "ConnectionDriver" parameter to specify the data source. ' ConnectionProvider Optional. You can either use this parameter to specify the data source by "PROVIDER", ' or you can specify the data source by "DRIVER" via the "ConnectionDriver" parameter ' ConnectionDriver Optional. You can either use this parameter to specify the data source by "DRIVER", ' or you can specify the data source by "PROVIDER" via the "ConnectionProvider" parameter ' ConnectionNetProtocol Optional. You can specify how to connect to the database via this parameter ' strServerName Optional. Specifies the server name to connect to. If you are connecting to a SQL ' or ORACLE database, you must specify this. Otherwise, this parameter is ignored. ' strDatabaseName Optional. Specifies the database name to connect to. If you are connecting to a SQL ' or ORACLE database, you must specify this. Otherwise, this parameter is ignored. ' strDataSource Optional. Specifies the database file or source. This parameter must be specified ' unless the database type is SQL or ORACLE. ' strUserName Optional. You can specify a user name to log into the database here ' strPassword Optional. You can specify a user password to log into the database here ' strWorkstationID Optional. You can specify your workstation ID (name) via this parameter ' lngPacketSize Optional. You can specify the packet size here ' blnPersistSecurityInfo Optional. You can specify whether to persist security info via this parameter ' blnUseEncryptionForData Optional. You can specify whether to use encryption for data here ' blnAutoTranslate Optional. You can specify whether to use auto translation here ' Return_ErrNum Optional. If an error occurs, this parameter returns the error number ' Return_ErrDesc Optional. If an error occurs, this parameter returns the error description ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function GenerateConnectionString(ByRef Return_ConnectionString As String, _ Optional ByVal blnRemoteServer As Boolean = False, _ Optional ByVal strRemoteServerURL As String, _ Optional ByVal lngRemoteServerTimeout As Long = -1, _ Optional ByVal strRemoteServerProvider As String = "", _ Optional ByVal blnDataShape As Boolean = False, _ Optional ByVal strDataShapeProvider As String = "", _ Optional ByVal ConnectionProvider As ConnProviders = cp_NotSpecified, _ Optional ByVal ConnectionDriver As ConnDrivers = cd_NotSpecified, _ Optional ByVal ConnectionNetProtocol As ConnNetProtocols = cn_NotSpecified, _ Optional ByVal strServerName As String, _ Optional ByVal strDatabaseName As String, _ Optional ByVal strDataSource As String, _ Optional ByVal strUserName As String, _ Optional ByVal strPassword As String, _ Optional ByVal strWorkstationID As String = "", _ Optional ByVal lngPacketSize As Long = -1, _ Optional ByVal blnPersistSecurityInfo As String = "", _ Optional ByVal blnUseEncryptionForData As String = "", _ Optional ByVal blnAutoTranslate As String = "", _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim strConn As String ' Clear variables Return_ConnectionString = "" Return_ErrNum = 0 Return_ErrDesc = "" strDataShapeProvider = Trim(strDataShapeProvider) strRemoteServerURL = Trim(strRemoteServerURL) strRemoteServerProvider = Trim(strRemoteServerProvider) strServerName = Trim(strServerName) strDatabaseName = Trim(strDatabaseName) strDataSource = Trim(strDataSource) strUserName = Trim(strUserName) strPassword = Trim(strPassword) strWorkstationID = Trim(strWorkstationID) blnPersistSecurityInfo = UCase(Trim(blnPersistSecurityInfo)) blnUseEncryptionForData = UCase(Trim(blnUseEncryptionForData)) blnAutoTranslate = UCase(Trim(blnAutoTranslate)) ' Validate parameters If blnDataShape = False And blnRemoteServer = False And ConnectionDriver = cd_NotSpecified And ConnectionProvider = cp_NotSpecified Then Return_ErrNum = -1 Return_ErrDesc = "No data provider specified" Exit Function ElseIf blnDataShape = False And blnRemoteServer = False And strServerName = "" And strDatabaseName = "" And strDataSource = "" Then Return_ErrNum = -1 Return_ErrDesc = "No data source specified" Exit Function ElseIf blnRemoteServer = True And strRemoteServerURL = "" Then Return_ErrNum = -1 Return_ErrDesc = "Remove Server specified as the data source, but no URL specified" Exit Function ElseIf blnDataShape = True And strDataShapeProvider = "" And ConnectionDriver = cd_NotSpecified Then Return_ErrNum = -1 Return_ErrDesc = "Data Shape specified, but no connection driver specified" Exit Function End If If blnRemoteServer = False And blnDataShape = False Then If ConnectionProvider <> cp_NotSpecified Then If (ConnectionProvider = cp_SQL Or ConnectionProvider = cp_Oracle) And (strServerName = "") Then Return_ErrNum = -1 Return_ErrDesc = "No server name specified" Exit Function ElseIf (ConnectionProvider = cp_SQL Or ConnectionProvider = cp_Oracle) And (strDatabaseName = "") Then Return_ErrNum = -1 Return_ErrDesc = "No database name specified" Exit Function ElseIf (ConnectionProvider <> cp_SQL And ConnectionProvider <> cp_Oracle And strDataSource = "") Then Return_ErrNum = -1 Return_ErrDesc = "No data source specified" Exit Function End If ElseIf ConnectionDriver <> cd_NotSpecified Then If (ConnectionDriver = cd_SQL Or ConnectionDriver = cd_Oracle) And (strServerName = "") Then Return_ErrNum = -1 Return_ErrDesc = "No server name specified" Exit Function ElseIf (ConnectionDriver = cd_SQL Or ConnectionDriver = cd_Oracle) And (strDatabaseName = "") Then Return_ErrNum = -1 Return_ErrDesc = "No database name specified" Exit Function ElseIf (ConnectionDriver <> cd_SQL And ConnectionDriver <> cd_Oracle And strDataSource = "") Then Return_ErrNum = -1 Return_ErrDesc = "No data source specified" Exit Function End If End If End If ' Build the connection string information If blnConnInfoBuilt = False Then ' Setup the connection driver strings - This information pulled from the MSDN.MICROSOFT.COM ReDim strConnDriv(1 To MAX_DRIVERS) As String strConnDriv(cd_Access) = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" 'physical path to .MDB file strConnDriv(cd_Excel) = "Driver={Microsoft Excel Driver (*.xls)};DriverID=278;DBQ=" 'physical path to .XLS file strConnDriv(cd_Excel_97) = "Driver={Microsoft Excel Driver (*.xls)};DriverID=790;DBQ=" 'physical path to .XLS file strConnDriv(cd_Paradox) = "Driver={Microsoft Paradox Driver (*.db)};DriverID=26;DBQ=" 'physical path to .DB file strConnDriv(cd_Text) = "Driver={Microsoft Text Driver (*.txt;*.csv)};DefaultDir=" 'physical path to .TXT file strConnDriv(cd_VFoxPro) = "Driver={Microsoft Visual FoxPro Driver};SourceType=DBC;SourceDb=" 'physical path to .DBF file strConnDriv(cd_VFoxPro_Cont) = "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDb=" 'physical path to .DBF file strConnDriv(cd_SQL) = "Driver={SQL Server};SERVER=" 'path to server strConnDriv(cd_Oracle) = "Driver={Microsoft ODBC for Oracle};SERVER=" 'path to server ' Setup the connection provider strings - This information pulled from the MSDN.MICROSOFT.COM ReDim strConnProv(1 To MAX_PROVIDERS) As String strConnProv(cp_Access) = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=4;Data Source=" 'physical path to .MDB file strConnProv(cp_dBaseIII) = "Provider=MSDASQL.1;Extended Properties=;DRIVER=Microsoft dBase Driver (*.dbf);DriverId=21;FIL=dBase III;MaxBufferSize=2048;PageTimeout=600;DefaultDir=" 'physical path to .DBF file strConnProv(cp_dBaseIV) = "Provider=MSDASQL.1;Extended Properties=;DRIVER=Microsoft dBase Driver (*.dbf);DriverId=21;FIL=dBase IV;MaxBufferSize=2048;PageTimeout=600;DefaultDir=" 'physical path to .DBF file strConnProv(cp_dBaseV) = "Provider=MSDASQL.1;Extended Properties=;DRIVER=Microsoft dBase Driver (*.dbf);DriverId=21;FIL=dBase V;MaxBufferSize=2048;PageTimeout=600;DefaultDir=" 'physical path to .DBF file strConnProv(cp_Excel) = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" 'physical path to .XLS file strConnProv(cp_HTML) = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=HTML Import;Data Source=" 'physical path or URL to HTM(L) file strConnProv(cp_MsIndexingSrv) = "Provider=MSIDXS.1;Data Source=" 'physical path to file strConnProv(cp_Text) = "Driver={Microsoft Text Driver (*.txt;*.csv)};DBQ=" 'physical path to .TXT file strConnProv(cp_Oracle) = "Provider=MSDAORA.1;Data Source=" 'path to database on server strConnProv(cp_SQL) = "Provider=SQLOLEDB.1;Data Source=" 'path to database on server ' Setup the connection provider strings - This information pulled from the "SQL Server Client Network Utility" that comes with SQL Server ReDim strConnNetProt(1 To MAX_NET_PROTOCOLS) As String strConnNetProt(cn_AppleTalk) = "Network Library=DBMSADSN" '.DLL strConnNetProt(cn_BanyanVINES) = "Network Library=DBMSVINN" '.DLL strConnNetProt(cn_IPX_SPX) = "Network Library=DBNETLIB" '.DLL strConnNetProt(cn_Multiprotocol) = "Network Library=DBMSRPCN" '.DLL strConnNetProt(cn_NamedPipes) = "Network Library=DBNMPNTW" '.DLL strConnNetProt(cn_TCP_IP) = "Network Library=DBNETLIB" '.DLL strConnNetProt(cn_VIA_Giganet) = "Network Library=DBMSGNET" '.DLL blnConnInfoBuilt = True End If ' Setup the data source for REMOTE SERVER If blnRemoteServer = True Then strConn = "Provider=MS Remote;Remote Server=" & strRemoteServerURL & ";" If lngRemoteServerTimeout > 0 Then strConn = strConn & "Internet Timeout=" & CStr(lngRemoteServerTimeout) & ";" strConn = strConn & "Data Source=" & strDataSource & ";" ' Setup the data source for DATA SHAPE ElseIf blnDataShape = True Then strConn = "Provider=MSDataShape;" If strDataShapeProvider <> "" Then strConn = strConn & "Data Provider=" & strDataShapeProvider & ";" Else strConn = strConn & strConnDriv(ConnectionDriver) If ConnectionDriver = cd_SQL Or ConnectionDriver = cd_Oracle Then strConn = strConn & strServerName & ";Database=" & strDatabaseName Else strConn = strConn & strDataSource & ";" End If End If Else ' Setup the data source based on the specified PROVIDER If ConnectionProvider <> cp_NotSpecified Then Select Case ConnectionProvider Case cp_Access, cp_dBaseIII, cp_dBaseIV, cp_dBaseV, cp_Excel, cp_HTML, cp_MsIndexingSrv, cp_Text strConn = strConnProv(ConnectionProvider) & strDataSource & ";" Case cp_Oracle, cp_SQL strConn = strConnProv(ConnectionProvider) & strServerName & ";Database=" & strDatabaseName & ";" Case Else Return_ErrNum = -1: Return_ErrDesc = "Unknown connection provider specified" Exit Function End Select ' Setup the data source based on the specified DRIVER ElseIf ConnectionDriver <> cd_NotSpecified Then Select Case ConnectionDriver Case cd_Access, cd_Excel, cd_Excel_97, cd_Paradox, cd_Text, cd_VFoxPro, cd_VFoxPro_Cont strConn = strConnDriv(ConnectionDriver) & strDataSource & ";" Case cd_SQL, cd_Oracle strConn = strConnDriv(ConnectionDriver) & strServerName & ";Database=" & strDatabaseName & ";" Case Else Return_ErrNum = -1: Return_ErrDesc = "Unknown connection driver specified" Exit Function End Select End If End If ' Setup the network protocol type if specified If ConnectionNetProtocol <> cn_NotSpecified Then Select Case ConnectionNetProtocol Case cn_AppleTalk, cn_BanyanVINES, cn_IPX_SPX, cn_Multiprotocol, cn_NamedPipes, cn_TCP_IP, cn_VIA_Giganet strConn = strConn & strConnNetProt(ConnectionNetProtocol) & ";" Case Else Return_ErrNum = -1: Return_ErrDesc = "Unknown connection driver specified" Exit Function End Select End If ' Specify the user name and password strConn = strConn & "UID=" & strUserName & ";PWD=" & strPassword & ";" ' Specify the packet size if the user wants to If lngPacketSize > 0 Then strConn = strConn & "Packet Size=" & CStr(lngPacketSize) & ";" End If ' Specify whether to persist security information or not If blnPersistSecurityInfo = "TRUE" Or blnPersistSecurityInfo = "FALSE" Then strConn = strConn & "Persist Security Info=" & blnPersistSecurityInfo & ";" End If ' Specify whether to use encryption for data or not If blnUseEncryptionForData = "TRUE" Or blnUseEncryptionForData = "FALSE" Then strConn = strConn & "Use Encryption for Data=" & blnUseEncryptionForData & ";" End If ' Specify whether to auto translate or not If blnAutoTranslate = "TRUE" Or blnAutoTranslate = "FALSE" Then strConn = strConn & "Auto Translate=" & blnAutoTranslate & ";" End If ' Specify the workstation ID (name) If strWorkstationID <> "" Then strConn = strConn & "Workstation ID=" & strWorkstationID & ";" End If ' Return the results Return_ConnectionString = strConn GenerateConnectionString = True End Function '============================================================================================================= ' SetConnectionString ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function sets the connection string of the ADODB.Connection object being used and checks for errors ' while doing so. ' ' NOTE: You can use the "GenerateConnectionString" function to create a valid connection string ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strConnectionString Specifies the connection string to use... which points to the database to use ' Return_ErrNum Optional. If an error occurs, this returns the error number ' Return_ErrDesc Optional. If an error occurs, this returns the error description ' ' Return ' ŻŻŻŻŻŻ ' Returns TRUE if function succeeds ' Returns FALSE if function fails '============================================================================================================= Public Function SetConnectionString(ByVal strConnectionString As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Clear variables Err.Clear Return_ErrNum = 0 Return_ErrDesc = "" strConnString = "" ' Clean up any previous connection before recreating it CleanupConnection conConnection ' Validate parameters strConnectionString = Trim(strConnectionString) If strConnectionString = "" Then SetConnectionString = True Exit Function End If ' Setup the new connection Set conConnection = New ADODB.Connection conConnection.CommandTimeout = lngCmdTimeout conConnection.ConnectionTimeout = lngConnTimeout conConnection.IsolationLevel = ConnIsolationLvl conConnection.mode = ConnMode conConnection.open strConnectionString ' Exit the function strConnString = strConnectionString SetConnectionString = True Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear CleanupConnection conConnection End Function '============================================================================================================= ' ValidateStringForSQL ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' This function takes a SQL string (like a value to be a parameter) and replaces all apostrophes ('), which ' are invalid characters and need to be escaped, with double apostrophes (''). SQL knows this is an escape ' and stores them correctly. Not calling this and passing a value like "How's it going?" as a parameter or ' string value to a database via SQL will cause errors because SQL things the string ends after "How". ' ' Param Use ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' strSQL Specifies the SQL string to escape ' ' Return ' ŻŻŻŻŻŻ ' Returns the escaped SQL string '============================================================================================================= Public Function ValidateStringForSQL(ByVal strSQL As String) As String ValidateStringForSQL = ReplaceChar(strSQL, Chr(39), Chr(39) & Chr(39)) ValidateStringForSQL = ReplaceChar(ValidateStringForSQL, Chr(34), Chr(39) & Chr(39)) End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' PRIVATE METHODS (Only used within this class) 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Takes a STRING array and checks to see if it has any elements in it by returning the Upper and Lower bounds of the array. Private Function ArrayIsEmpty_STR(ByRef TheArray() As String, _ Optional ByRef Return_LBound As Long, _ Optional ByRef Return_UBound As Long) As Boolean On Error GoTo ErrorTrap ' Set the default return values Return_LBound = -1 Return_UBound = -1 ArrayIsEmpty_STR = True ' By checking the L and U bound of the array, you'll see if the array is empty Return_LBound = LBound(TheArray) Return_UBound = UBound(TheArray) ' If it made it this far, the array isn't empty ArrayIsEmpty_STR = False Exit Function ErrorTrap: Err.Clear End Function ' Takes a BOOLEAN array and checks to see if it has any elements in it by returning the Upper and Lower bounds of the array. Private Function ArrayIsEmpty_BLN(ByRef TheArray() As Boolean, _ Optional ByRef Return_LBound As Long, _ Optional ByRef Return_UBound As Long) As Boolean On Error GoTo ErrorTrap ' Set the default return values Return_LBound = -1 Return_UBound = -1 ArrayIsEmpty_BLN = True ' By checking the L and U bound of the array, you'll see if the array is empty Return_LBound = LBound(TheArray) Return_UBound = UBound(TheArray) ' If it made it this far, the array isn't empty ArrayIsEmpty_BLN = False Exit Function ErrorTrap: Err.Clear End Function ' Takes a VARIANT array and checks to see if it has any elements in it by returning the Upper and Lower bounds of the array. Private Function ArrayIsEmpty_VAR(ByRef TheArray() As Variant, _ Optional ByRef Return_LBound As Long, _ Optional ByRef Return_UBound As Long) As Boolean On Error GoTo ErrorTrap ' Set the default return values Return_LBound = -1 Return_UBound = -1 ArrayIsEmpty_VAR = True ' By checking the L and U bound of the array, you'll see if the array is empty Return_LBound = LBound(TheArray) Return_UBound = UBound(TheArray) ' If it made it this far, the array isn't empty ArrayIsEmpty_VAR = False Exit Function ErrorTrap: Err.Clear End Function ' This function takes an ADODB.Command object and returns the values of the parameters within it to parameter's that have the same name. Private Function AssignReturnValue(ByRef ParameterNames() As String, _ ByRef ParameterValues() As Variant, _ ByRef objCommand As ADODB.Command, _ ByVal TheLBound As Long, _ ByVal TheUBound As Long) As Boolean On Error Resume Next Dim objParam As ADODB.parameter Dim lngCounter As Long Dim strParam As String If objCommand.Parameters.Count = 0 Then AssignReturnValue = True Exit Function End If ' Loop through the parameters in the command object's Parameters collection For Each objParam In objCommand.Parameters ' Make sure all the parameters are in the same format strParam = UCase(Trim(objParam.Name)) If strParam <> "" Then If Left(strParam, 1) <> "@" Then strParam = "@" & strParam End If ' Look for a parameter that was passed in that matches the name and re-assign the value to it if found For lngCounter = TheLBound To TheUBound If ParameterNames(lngCounter) <> "" Then ' Check if the current parameter name is the same... and if it is, get the value back If UCase(Trim(ParameterNames(lngCounter))) = strParam Then If Trim(objParam.Value) & "" = "" Then ParameterValues(lngCounter) = Empty Else ParameterValues(lngCounter) = objParam.Value End If GoTo Continue End If End If Next Continue: Next AssignReturnValue = True End Function ' Checks to see if a valid connection exists, and if one doesn't, establishes one Private Function CheckConnection(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Clear variables Err.Clear Return_ErrNum = 0 Return_ErrDesc = "" ' Check if the connection string is valid If strConnString = "" Then Return_ErrNum = -1 Return_ErrDesc = "No connection string specified" Exit Function ' Check if the connection exists, and if it doesn't, create it ElseIf conConnection Is Nothing Then Set conConnection = New ADODB.Connection ' Check if the connection is still valid, and re-create it if it's not ElseIf conConnection.State <> adStateOpen Then CleanupConnection conConnection Set conConnection = New ADODB.Connection ' The connection seems to be fine at this point. It is declared, initialized, and open. Else CheckConnection = True Exit Function End If ' Setup the connection, then connect to the database conConnection.CommandTimeout = lngCmdTimeout conConnection.ConnectionTimeout = lngConnTimeout conConnection.IsolationLevel = ConnIsolationLvl conConnection.mode = ConnMode conConnection.open strConnString CheckConnection = True Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear End Function ' This function gives VB5 the functionality that VB6 gives via the "Replace" function Private Function ReplaceChar(ByVal strSearchString As String, _ ByVal strSearchChar As String, _ ByVal strReplaceChar As String) As String On Error Resume Next Dim lngCounter As Long Dim CharLeft As String Dim CharRight As String Dim strLeft As String Dim strRight As String ReplaceChar = strSearchString If strSearchString = "" Then Exit Function If strSearchChar = "" Then Exit Function If strSearchChar = strReplaceChar Then Exit Function If InStr(strSearchString, strSearchChar) <= 0 Then Exit Function lngCounter = 1 TheBegin: For lngCounter = lngCounter To Len(strSearchString) CharLeft = Left(strSearchString, lngCounter) CharRight = Right(CharLeft, Len(strSearchChar)) If CharRight = strSearchChar Then strLeft = Left(CharLeft, Len(CharLeft) - Len(strSearchChar)) strRight = Right(strSearchString, (Len(strSearchString) - Len(strLeft)) - Len(strSearchChar)) strSearchString = strLeft & strReplaceChar & strRight lngCounter = Len(strLeft) + Len(strReplaceChar) + 1 GoTo TheBegin End If Next ReplaceChar = strSearchString End Function