VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "CDBIRSData" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Compare Database Option Explicit 'need connection objects (cmd, rst, cnn) 'ned connection methods (create string, open, close) 'enum for fields 'methods:, add, delete, edit, populate (ctl), filter, reset Private Const gdblDBIRSViewer_Version As Double = 0.9 Private Const gstrSupportInfo = "James Igoe (eMail: james.igoe@db.com)" Public Enum LoginCheckValue NoUserID = 0 ValidUser = 1 NoRoleMembership = 2 End Enum Public Enum ColumnName EventID = 1 Region = 2 Business = 3 ReportingPerson = 4 EventCategory = 5 EventDetail = 6 RiskType = 7 RegulatoryFlag = 8 CausingUnitDivisional = 9 AbsValue = 10 End Enum Private Enum ConnectionType SQLServer2005_SPPI = 1 SQLServer2005_NonSPPI = 2 End Enum Public Enum DataFilter NoFilter = 1 TMG = 2 End Enum 'values for ado connection to server Private gconnConnection As ADODB.Connection Private grstRecordset As ADODB.Recordset Private grstRecordset_Temp As ADODB.Recordset Private gcmdCommand As ADODB.Command Private gstrConnectionString As String Private rstRecordset_List As New ADODB.Recordset Private mvarErrorReturn As Variant '2005 'Home 'Private Const gstrWRAPDataSource = "Server=COMPARAT-79E1CF\SQLEXPRESS;" 'Private Const gstrWRAPDataCatalog = "Database=DBIRS;" 'office 'server dtails have been removed; you will need to supply Private Const gstrWRAPDataSource = "Server=;" Private Const gstrWRAPDataCatalog = "Database=;" Private Const gstrCredentials = "Uid=;Pwd=;" Private Const gstrWRAPProvider = "Provider=Microsoft.Access.OLEDB.10.0;" Private Const gstrWRAPDataProvider = "Data Provider=SQLOLEDB;" Private Const gstrWRAPDataSSPI = "Integrated Security=SSPI;" 'DBIRSViewer storedprocs and views Private Const str_spDBIRSViewer_CheckEventIDExists = "spDBIRSViewer_CheckEventIDExists" Private Const str_spDBIRSViewer_CheckDBIRSVersion = "spDBIRSViewer_CheckDBIRSVersion" Private Const str_spDBIRSViewer_CheckUserID = "spDBIRSViewer_CheckUserID" Private Const str_spDBIRSViewer_Main_All = "spDBIRSViewer_Main_All" Private Const str_spDBIRSViewer_EventDetails = "spDBIRSViewer_EventDetails" Private Const str_spDBIRSViewer_EventDetails_Update = "spDBIRSViewer_EventDetails_Update" Private Const str_spDBIRSViewer_ColumnValues = "spDBIRSViewer_ColumnValues" Private Const str_spDBIRSViewer_CellValues = "spDBIRSViewer_CellValues" Private Const str_spDBIRSViewer_FilterValues = "spDBIRSViewer_FilterValues" Private Const str_spDBIRSViewer_EventDetails_List_Applications_PrimaryRootCause = "spDBIRSViewer_List_Applications_PrimaryRootCause" Private Const str_spDBIRSViewer_EventDetails_List_RootCause = "spDBIRSViewer_List_RootCause" Private Const str_spDBIRSViewer_EventDetails_List_RootCauseSubtype = "spDBIRSViewer_List_RootCauseSubtype" Private Const str_spDBIRSViewer_EventDetails_List_Products = "spDBIRSViewer_List_Products" Private Const str_spDBIRSViewer_EventDetails_List_Regions = "spDBIRSViewer_List_Regions" Private Const str_spDBIRSViewer_EventDetails_List_EventCategory = "spDBIRSViewer_List_EventCategory" Private Const str_spDBIRSViewer_EventDetails_List_EventCategorySubtype = "spDBIRSViewer_List_EventCategorySubtype" Private Const str_spDBIRSViewer_EventDetails_List_TMG_BusinessApprover = "spDBIRSViewer_List_TMG_BusinessApprover" Private Const str_spDBIRSViewer_EventDetails_List_TMG_ControlApprover = "spDBIRSViewer_List_TMG_ControlApprover" Private Const str_spDBIRSViewer_List_Applications_PrimaryRootCause = "spDBIRSViewer_List_Applications_PrimaryRootCause" Private Const str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause = "spDBIRSViewer_EventDetails_Applications_PrimaryRootCause" Private Const str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Add = "spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Add" Private Const str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Delete = "spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Delete" Private Const str_spDBIRSViewer_List_Applications_SecondaryRootCause = "spDBIRSViewer_List_Applications_SecondaryRootCause" Private Const str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause = "spDBIRSViewer_EventDetails_Applications_SecondaryRootCause" Private Const str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Add = "spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Add" Private Const str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Delete = "spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Delete" Private Const str_spDBIRSViewer_EventDetails_SecondaryCauses = "spDBIRSViewer_EventDetails_SecondaryCauses" Private Const str_spDBIRSViewer_EventDetails_SecondaryCauses_Update = "spDBIRSViewer_EventDetails_SecondaryCauses_Update" Private Const str_spDBIRSViewer_EventDetails_SecondaryCauses_Add = "spDBIRSViewer_EventDetails_SecondaryCauses_Add" Private Const str_spDBIRSViewer_EventDetails_SecondaryCauses_Delete = "spDBIRSViewer_EventDetails_SecondaryCauses_Delete" Private Const str_spDBIRSViewer_List_ControlPlatform = "spDBIRSViewer_List_ControlPlatform" Private Const str_spDBIRSViewer_EventDetails_ControlPlatforms = "spDBIRSViewer_EventDetails_ControlPlatforms" Private Const str_spDBIRSViewer_EventDetails_ControlPlatforms_Add = "spDBIRSViewer_EventDetails_ControlPlatforms_Add" Private Const str_spDBIRSViewer_EventDetails_ControlPlatforms_Delete = "spDBIRSViewer_EventDetails_ControlPlatforms_Delete" Private Const str_spDBIRSViewer_List_RCSARiskTheme = "spDBIRSViewer_List_RCSARiskTheme" Private Const str_spDBIRSViewer_EventDetails_RCSARiskThemes = "spDBIRSViewer_EventDetails_RCSARiskThemes" Private Const str_spDBIRSViewer_EventDetails_RCSARiskThemes_Add = "spDBIRSViewer_EventDetails_RCSARiskThemes_Add" Private Const str_spDBIRSViewer_EventDetails_RCSARiskThemes_Delete = "spDBIRSViewer_EventDetails_RCSARiskThemes_Delete" Private Const str_spDBIRSViewer_EventDetails_List_ActionTypes = "spDBIRSViewer_List_ActionTypes" Private Const str_spDBIRSViewer_EventDetails_Actions = "spDBIRSViewer_EventDetails_Actions" Private Const str_spDBIRSViewer_EventDetails_Actions_Update = "spDBIRSViewer_EventDetails_Actions_Update" Private Const str_spDBIRSViewer_EventDetails_Actions_Add = "spDBIRSViewer_EventDetails_Actions_Add" Private Const str_spDBIRSViewer_EventDetails_Actions_Delete = "spDBIRSViewer_EventDetails_Actions_Delete" Private Const str_spDBIRSViewer_EventDetails_List_BusinessDrivers = "spDBIRSViewer_List_BusinessDrivers" Private Const str_spDBIRSViewer_EventDetails_BusinessDrivers = "spDBIRSViewer_EventDetails_BusinessDrivers" Private Const str_spDBIRSViewer_EventDetails_List_ActionStatus = "spDBIRSViewer_List_ActionStatus" Private Const str_spDBIRSViewer_EventDetails_ActionStatus = "spDBIRSViewer_EventDetails_ActionStatus" Private Const str_spDBIRSViewer_EventDetails_List_CTB_Flag = "spDBIRSViewer_List_CTB_Flag" Private Const str_spDBIRSViewer_EventDetails_CTB_Flag = "spDBIRSViewer_EventDetails_CTB_Flag" Private Sub Class_Initialize() OpenConnection End Sub Private Sub Class_Terminate() CloseConnection End Sub Private Function GetConnectToDBString(lngConnectionType As ConnectionType) As String Select Case lngConnectionType Case SQLServer2005_NonSPPI GetConnectToDBString = gstrWRAPProvider & gstrWRAPDataProvider & gstrWRAPDataSource & gstrWRAPDataCatalog & gstrCredentials Case SQLServer2005_SPPI GetConnectToDBString = gstrWRAPProvider & gstrWRAPDataProvider & gstrWRAPDataSource & gstrWRAPDataCatalog & gstrWRAPDataSSPI Case Else GetConnectToDBString = "" End Select ExitFX: Exit Function End Function Public Property Get VersionInfo() As Double VersionInfo = gdblDBIRSViewer_Version End Property Private Function OpenConnection() On Error GoTo ErrorTrap ''requires subsequent code to close recordset Dim strStoredProc As String Dim lngRightCheck As LoginCheckValue Dim rstReturnValue As ADODB.Recordset ' Connects to the DB, calling function for string gstrConnectionString = GetConnectToDBString(SQLServer2005_SPPI) Set gconnConnection = New ADODB.Connection gconnConnection.Open gstrConnectionString strStoredProc = str_spDBIRSViewer_CheckUserID & " '" & Environ("USERDOMAIN") & "','" & Environ("USERNAME") & "'" Set rstReturnValue = gconnConnection.Execute(strStoredProc) If rstReturnValue.EOF = False Then rstReturnValue.MoveFirst Select Case rstReturnValue(0) Case 0 GoTo ErrorTrap Case 1 Set gcmdCommand = New ADODB.Command gcmdCommand.ActiveConnection = gconnConnection strStoredProc = str_spDBIRSViewer_CheckDBIRSVersion Set rstReturnValue = Nothing Set rstReturnValue = gconnConnection.Execute(strStoredProc) rstReturnValue.MoveFirst If rstReturnValue(0) > gdblDBIRSViewer_Version Then err.Raise vbObjectError + 515, "dbIRS Viewer", "This version of DBIRS Viewer application is out of date." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." End If End Select End If ExitFX: If IsObject(rstReturnValue) Then Set rstReturnValue = Nothing Exit Function ErrorTrap: Select Case err.Number Case 424 err.Raise vbObjectError + 513, "dbIRS Viewer", "Connection to the server failed; invalid connection or no rights to access data." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." Case -2147220989 err.Raise vbObjectError + 515, "dbIRS Viewer", "This version of DBIRS Viewer application is out of date." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." Case Else err.Raise vbObjectError + 514, "dbIRS Viewer", "Connection to the server failed." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." End Select GoTo ExitFX End Function Private Function CloseConnection() As Boolean On Error GoTo ErrorTrap If IsObject(grstRecordset) Then Set grstRecordset = Nothing If IsObject(gcmdCommand) Then Set gcmdCommand = Nothing If IsObject(gconnConnection) Then Set gconnConnection = Nothing CloseConnection = True ExitFX: Exit Function ErrorTrap: err.Raise vbObjectError + 525, "dbIRS Viewer", "Failed to close connection to server" CloseConnection = False GoTo ExitFX End Function Public Function GetData(ByRef ctlListBox As ListBox, ByVal strFilter As String) ''used several times in forms to get column headings ''consider writing as class ''requires subsequent code to close recordset On Error GoTo ErrorTrap ' holder for transposed array Dim arrTempArray As Variant If strFilter = "" Then strFilter = "TMG" End If ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_Main_All & "('" & strFilter & "')" .CommandType = adCmdStoredProc Set grstRecordset = .Execute End With Set grstRecordset_Temp = grstRecordset ' retuns recordset Set ctlListBox.Recordset = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 535, "dbIRS Viewer", "Fatal error, failed to get data from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Property Get Recordset() As ADODB.Recordset grstRecordset.Filter = adFilterNone Set Recordset = grstRecordset End Property Public Function Filter(ByRef ctlControl As Control, strFilterString As String) Set grstRecordset_Temp = ctlControl.Recordset With grstRecordset_Temp .Filter = strFilterString End With Set ctlControl.Recordset = grstRecordset_Temp Set grstRecordset_Temp = Nothing End Function Public Function UnFilter(ByRef ctlControl As Control) Set grstRecordset_Temp = CDataObject.Recordset.Filter(adFilterNone) Set ctlControl.Recordset = grstRecordset_Temp Set grstRecordset_Temp = Nothing End Function Private Function DeriveColumnHeading(ColumnWanted As ColumnName) As String Select Case ColumnWanted Case 1: DeriveColumnHeading = "Event ID" Case 2: DeriveColumnHeading = "Region" Case 3: DeriveColumnHeading = "Business" Case 4: DeriveColumnHeading = "Reporting Person" Case 5: DeriveColumnHeading = "Event Category" Case 6: DeriveColumnHeading = "Event Detail" Case 7: DeriveColumnHeading = "Risk Type" Case 8: DeriveColumnHeading = "Regulatory Flag" Case 9: DeriveColumnHeading = "Causing Unit Divisional" Case 10: DeriveColumnHeading = "Absolute Value" End Select End Function Private Function Populate(ByRef ctlControl As Control, ColumnWanted As ColumnName) On Error GoTo ErrorTrap 'get recordset 'get column name 'loop column and create temp recordset 'set recordset to ctl Dim strColumnName As String strColumnName = DeriveColumnHeading(ColumnWanted) With rstRecordset_List With .Fields .Append strColumnName, adVarChar, 255 End With .CursorLocation = adUseClient .CursorType = adOpenDynamic .Open End With With grstRecordset .MoveFirst While Not .EOF rstRecordset_List.AddNew rstRecordset_List.Fields(0) = .Fields(strColumnName).Value .MoveNext Wend End With Set ctlControl.Recordset = rstRecordset_List ExitFX: Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 545, "dbIRS Viewer", "Failed to get column data from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function GetColumn(ByRef ctlControl As Control, ByVal ColumnWanted As ColumnName, ByVal strFilter As String) On Error GoTo ErrorTrap 'check for control 'clear 'test for column name value 'create list of unique value 'populate ctl Dim strColumnName As String strColumnName = DeriveColumnHeading(ColumnWanted) ' creates SQL string and executes gcmdCommand.CommandText = str_spDBIRSViewer_ColumnValues & " [" & strColumnName & "], '" & strFilter & "'" gcmdCommand.CommandType = adCmdText Set grstRecordset_Temp = gcmdCommand.Execute ' retuns recordset Set ctlControl.Recordset = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 555, "Invalid column specification or server not responding." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function GetCells(ByRef ctlControl As Control, ByVal ColumnWanted As ColumnName, ByVal intEventID As Long) On Error GoTo ErrorTrap 'check for control 'clear 'test for column name value 'create list of unique value 'populate ctl Dim strColumnName As String strColumnName = DeriveColumnHeading(ColumnWanted) ' creates SQL string and executes Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_CellValues & " " & intEventID & ",'" & strColumnName & "'" .ActiveConnection = gconnConnection .Open .MoveFirst ctlControl.Value = grstRecordset_Temp(0) End With ExitFX: Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 565, "dbIRS Viewer", "Failed to get field data from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Property Get EventDetails(ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim intEventID As Long Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails & " " & lngEventID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 575, "dbIRS Viewer", "Failed to get event details from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_ControlPlatforms(ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim intEventID As Long Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_ControlPlatforms & " " & lngEventID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_ControlPlatforms = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 585, "dbIRS Viewer", "Failed to get FOBO Control Platforms eventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_Applications_PrimaryRootCause(ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim intEventID As Long Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause & " " & lngEventID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_Applications_PrimaryRootCause = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 585, "dbIRS Viewer", "Failed to get Applications for the EventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_Applications_SecondaryRootCause(ByVal lngEventID As Long, ByVal lngSecondaryRootCauseID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim intEventID As Long Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause & " " & lngEventID & ", " & lngSecondaryRootCauseID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_Applications_SecondaryRootCause = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 585, "dbIRS Viewer", "Failed to get Applications for the EventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_RCSARiskThemes(ByVal lngEventID As Long) As ADODB.Recordset Dim intEventID As Long On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_RCSARiskThemes & " " & lngEventID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_RCSARiskThemes = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 595, "dbIRS Viewer", "Failed to get FOBO Control Platforms eventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_SecondaryCauses(ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim intEventID As Long Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_SecondaryCauses & " " & lngEventID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_SecondaryCauses = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 605, "dbIRS Viewer", "Failed to get Secondary Causes for eventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Function EventDetails_SecondaryCauses_Update(ByVal SecondaryCauseID As Integer, _ ByVal F_EventID As Long, _ ByVal RootCauseTypeID As Integer, _ ByVal RootCauseSubtypeID As Integer, _ ByVal TimeStamp_EventDetail_SecondaryCauses As Date, _ ByVal ActionType As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_SecondaryCauses_Update & " " & _ SecondaryCauseID & "," & _ F_EventID & "," & _ RootCauseTypeID & "," & _ RootCauseSubtypeID & ",'" & _ TimeStamp_EventDetail_SecondaryCauses & "'," & _ ActionType .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_SecondaryCauses_Update = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 615, "dbIRS Viewer", "Failed to update Secondary Causes data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Actions_Update(ByVal F_EventID As Long, _ ByVal ActionID As Long, _ ByVal ProblemStatement As String, _ ByVal ProposedSolution As String, _ ByVal ActionType As Long, _ ByVal BusinessDriver As Long, _ ByVal ActionOwner As String, _ ByVal CTB_Flag As Long, _ ByVal TargetDate As String, _ ByVal ActionStatus As Long, _ ByVal TMGBusinessApprover As Long, _ ByVal TMGControlApprover As Long, _ ByVal TimeStamp_EventDetails_Actions As Date, _ ByVal OverRide As Boolean) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Actions_Update & " " & _ F_EventID & "," & _ ActionID & ",'" & _ CharacterReplace(ProblemStatement) & "','" & _ CharacterReplace(ProposedSolution) & "'," & _ ActionType & "," & _ BusinessDriver & ",'" & _ CharacterReplace(ActionOwner) & "'," & _ CTB_Flag & ",'" & _ TargetDate & "'," & _ ActionStatus & "," & _ TMGBusinessApprover & "," & _ TMGControlApprover & ",'" & _ TimeStamp_EventDetails_Actions & "'," & _ OverRide ' Debug.Print .CommandText .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Actions_Update = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 615, "dbIRS Viewer", "Failed to update Actions data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Actions_Add(ByVal F_EventID As Long, _ ByVal ProblemStatement As String, _ ByVal ProposedSolution As String, _ ByVal ActionType As Long, _ ByVal BusinessDriver As Long, _ ByVal ActionOwner As String, _ ByVal CTB_Flag As Long, _ ByVal TargetDate As String, _ ByVal ActionStatus As Long, _ ByVal TMGBusinessApprover As Long, _ ByVal TMGControlApprover As Long) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Actions_Add & " " & _ F_EventID & ",'" & _ CharacterReplace(ProblemStatement) & "','" & _ CharacterReplace(ProposedSolution) & "'," & _ ActionType & "," & _ BusinessDriver & ",'" & _ CharacterReplace(ActionOwner) & "'," & _ CTB_Flag & ",'" & _ TargetDate & "'," & _ ActionStatus & "," & _ TMGBusinessApprover & "," & _ TMGControlApprover ' Debug.Print .CommandText .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Actions_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 615, "dbIRS Viewer", "Failed to add Actions data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_SecondaryCauses_Add(ByVal F_EventID As Long, _ ByVal RootCauseTypeID As Integer, _ ByVal RootCauseSubtypeID As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_SecondaryCauses_Add & " " & _ F_EventID & "," & _ RootCauseTypeID & "," & _ RootCauseSubtypeID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_SecondaryCauses_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 625, "dbIRS Viewer", "Failed to add Secondary Causes data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_SecondaryCauses_Delete(ByVal SecondaryCauseID As Integer) As Recordset On Error GoTo ErrorTrap '@SecondaryCauseID AS INT, '@F_EventID AS NVARCHAR(10), '@RootCauseTypeID AS INT, '@RootCauseSubtypeID AS INT, '@TimeStamp_EventDetail_SecondaryCauses AS DATETIME, '@ActionType AS INT ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_SecondaryCauses_Delete & " " & _ SecondaryCauseID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_SecondaryCauses_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 635, "dbIRS Viewer", "Failed to delete Secondary Causes data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Actions_Delete(ByVal ActionID As Integer, _ ByVal F_EventID As Long) As Recordset On Error GoTo ErrorTrap '@ActionID AS INT, '@F_EventID AS NVARCHAR(10), '@RootCauseTypeID AS INT, '@RootCauseSubtypeID AS INT, '@TimeStamp_EventDetail_Actions AS DATETIME, '@ActionType AS INT ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Actions_Delete & " " & _ ActionID & "," & _ F_EventID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Actions_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 635, "dbIRS Viewer", "Failed to delete Actions data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Applications_PrimaryRootCause_Add(ByVal F_EventID As Long, _ ByVal ApplicationID As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Add & " " & _ F_EventID & "," & _ ApplicationID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Applications_PrimaryRootCause_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 645, "dbIRS Viewer", "Failed to add Control Platforms to EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Applications_PrimaryRootCause_Delete(ByVal ApplicationID As Integer, _ ByVal F_EventID As Long) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Applications_PrimaryRootCause_Delete & " " & _ ApplicationID & "," & _ F_EventID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Applications_PrimaryRootCause_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 655, "dbIRS Viewer", "Failed to delete Control Platforms from EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Applications_SecondaryRootCause_Add(ByVal F_EventID As Long, _ ByVal F_EventIDSecondayCauseID As Long, ByVal ApplicationID As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Add & " " & _ F_EventID & "," & _ F_EventIDSecondayCauseID & "," & _ ApplicationID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Applications_SecondaryRootCause_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 645, "dbIRS Viewer", "Failed to add Control Platforms to EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_Applications_SecondaryRootCause_Delete(ByVal F_Application_SecondaryRootCausedID As Long) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Applications_SecondaryRootCause_Delete & " " & F_Application_SecondaryRootCausedID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Applications_SecondaryRootCause_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 655, "dbIRS Viewer", "Failed to delete Control Platforms from EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_ControlPlatforms_Add(ByVal F_EventID As Long, _ ByVal ControlPlatformID As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_ControlPlatforms_Add & " " & _ F_EventID & "," & _ ControlPlatformID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_ControlPlatforms_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 645, "dbIRS Viewer", "Failed to add Control Platforms to EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_ControlPlatforms_Delete(ByVal ControlPlatformID As Integer, _ ByVal F_EventID As Long) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_ControlPlatforms_Delete & " " & _ ControlPlatformID & "," & _ F_EventID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_ControlPlatforms_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 655, "dbIRS Viewer", "Failed to delete Control Platforms from EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_RCSARiskThemes_Add(ByVal F_EventID As Long, _ ByVal RCSARiskThemeID As Integer) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_RCSARiskThemes_Add & " " & _ F_EventID & "," & _ RCSARiskThemeID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_RCSARiskThemes_Add = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 675, "dbIRS Viewer", "Failed to add RCSA Risk Themes to EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Function EventDetails_RCSARiskThemes_Delete(ByVal RCSARiskThemeID As Integer, _ ByVal F_EventID As Long) As Recordset On Error GoTo ErrorTrap '@SecondaryCauseID AS INT, '@F_EventID AS NVARCHAR(10), '@RootCauseTypeID AS INT, '@RootCauseSubtypeID AS INT, '@TimeStamp_EventDetail_RCSARiskThemes AS DATETIME, '@ActionType AS INT ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_RCSARiskThemes_Delete & " " & _ RCSARiskThemeID & "," & _ F_EventID .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_RCSARiskThemes_Delete = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: err.Raise vbObjectError + 685, "dbIRS Viewer", "Failed to delete RCSA Risk Theme from EventID data on server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Function Public Property Get EventDetails_List_RootCausesSubtype(ByVal intCauseID As Integer) As ADODB.Recordset Dim intEventID As Long On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_List_RootCauseSubtype & " " & intCauseID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_RootCausesSubtype = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 695, "dbIRS Viewer", "Failed to get list of Root Cause Subtypes from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Private Property Get EventDetails_List_Generic(ByVal strSource As String) As ADODB.Recordset On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = strSource .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_Generic = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 705, "dbIRS Viewer", "Failed to get list from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_RCSARiskTheme(Optional ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim strSource_Temp As String Set grstRecordset_Temp = New ADODB.Recordset If lngEventID <> 0 Then strSource_Temp = str_spDBIRSViewer_List_RCSARiskTheme & "(" & lngEventID & ")" Else strSource_Temp = str_spDBIRSViewer_List_RCSARiskTheme & "''" End If With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = strSource_Temp .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_RCSARiskTheme = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 715, "dbIRS Viewer", "Failed to get list of RCSA Risk Themes from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_Applications_PrimaryRootCause(Optional ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim strSource_Temp As String Set grstRecordset_Temp = New ADODB.Recordset If lngEventID <> 0 Then strSource_Temp = str_spDBIRSViewer_EventDetails_List_Applications_PrimaryRootCause & "(" & lngEventID & ")" Else strSource_Temp = str_spDBIRSViewer_EventDetails_List_Applications_PrimaryRootCause & "''" End If With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = strSource_Temp .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_Applications_PrimaryRootCause = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 725, "dbIRS Viewer", "Failed to get list of Control Platforms from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_Applications_SecondaryRootCause(ByVal lngEventID As Long, ByVal lngSecondaryRootCauseID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim strSource_Temp As String Set grstRecordset_Temp = New ADODB.Recordset If lngSecondaryRootCauseID <> 0 Then strSource_Temp = str_spDBIRSViewer_List_Applications_SecondaryRootCause & "(" & lngEventID & "," & lngSecondaryRootCauseID & ")" Else strSource_Temp = str_spDBIRSViewer_List_Applications_SecondaryRootCause & "(" & lngEventID & ",)" End If With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = strSource_Temp .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_Applications_SecondaryRootCause = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 725, "dbIRS Viewer", "Failed to get list of Control Platforms from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_ControlPlatform(Optional ByVal lngEventID As Long) As ADODB.Recordset On Error GoTo ErrorTrap Dim strSource_Temp As String Set grstRecordset_Temp = New ADODB.Recordset If lngEventID <> 0 Then strSource_Temp = str_spDBIRSViewer_List_ControlPlatform & "(" & lngEventID & ")" Else strSource_Temp = str_spDBIRSViewer_List_ControlPlatform & "''" End If With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = strSource_Temp .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_List_ControlPlatform = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 725, "dbIRS Viewer", "Failed to get list of Control Platforms from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_RootCauses() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_RootCauses = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_RootCause) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 735, "dbIRS Viewer", "Failed to get list of Root Causes from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_Products() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_Products = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_Products) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 745, "dbIRS Viewer", "Failed to get Poduct list from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_Regions() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_Regions = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_Regions) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 755, "dbIRS Viewer", "Failed to get list of Regions from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_ActionTypes() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_ActionTypes = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_ActionTypes) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 755, "dbIRS Viewer", "Failed to get list of Action Types from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_BusinessDrivers() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_BusinessDrivers = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_BusinessDrivers) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 755, "dbIRS Viewer", "Failed to get list of Business Drivers from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_ActionStatus() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_ActionStatus = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_ActionStatus) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 755, "dbIRS Viewer", "Failed to get list of Action Statuses from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_CTB_Flag() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_CTB_Flag = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_CTB_Flag) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 755, "dbIRS Viewer", "Failed to get list of Action Statuses from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_TMG_BusinessApprover() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_TMG_BusinessApprover = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_TMG_BusinessApprover) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 805, "dbIRS Viewer", "Failed to get list of TMG Business Approvers from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_List_TMG_ControlApprover() As ADODB.Recordset On Error GoTo ErrorTrap Set EventDetails_List_TMG_ControlApprover = EventDetails_List_Generic(str_spDBIRSViewer_EventDetails_List_TMG_ControlApprover) ExitFX: Exit Property ErrorTrap: err.Raise vbObjectError + 815, "dbIRS Viewer", "Failed to get list of TMG Control Approvers from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get GetFilters() As ADODB.Recordset Dim intEventID As Long On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_FilterValues .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set GetFilters = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 825, "dbIRS Viewer", "Failed to get list of data filters from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get CheckEventIDExists(ByVal lngEventID As Long, ByVal strFilter As String) As ADODB.Recordset Dim intEventID As Long On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_CheckEventIDExists & " " & lngEventID & ",'" & strFilter & "'" .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set CheckEventIDExists = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 835, "dbIRS Viewer", "Unable to check if Event ID is valid." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Property Get EventDetails_Actions(ByVal lngEventID As Long, Optional ByVal varActionPlanID As Variant) As ADODB.Recordset Dim intEventID As Long On Error GoTo ErrorTrap Set grstRecordset_Temp = New ADODB.Recordset If IsMissing(varActionPlanID) Then varActionPlanID = "''" With grstRecordset_Temp .CursorLocation = adUseClient .CursorType = adOpenKeyset .Source = str_spDBIRSViewer_EventDetails_Actions & " " & lngEventID & "," & varActionPlanID .ActiveConnection = gconnConnection .Open End With ' retuns recordset Set EventDetails_Actions = grstRecordset_Temp ExitFX: Set grstRecordset_Temp = Nothing Exit Property ErrorTrap: err.Raise vbObjectError + 845, "dbIRS Viewer", "Failed to get Actions for this eventID from server." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." GoTo ExitFX End Property Public Function EventDetails_Update(ByVal lngF_EventID As Long, _ ByVal strRootCauseSummary As String, _ ByVal strTrader As String, _ ByVal intRegionTrader As Integer, _ ByVal strSalesPerson As String, _ ByVal intRegionSalesPerson As Integer, _ ByVal strCorrectiveMeasuresSummary As String, _ ByVal intPrimaryRootCause As Integer, _ ByVal intPrimaryRootCause_Type As Integer, _ ByVal dtTimeStamp_EventDetail As Date, _ ByVal bolOverRide As Boolean) As Recordset On Error GoTo ErrorTrap ' creates SQL string and executes With gcmdCommand .CommandText = str_spDBIRSViewer_EventDetails_Update & " " & _ lngF_EventID & ",'" & _ CharacterReplace(strRootCauseSummary) & "','" & _ CharacterReplace(strTrader) & "'," & _ intRegionTrader & ",'" & _ CharacterReplace(strSalesPerson) & "'," & _ intRegionSalesPerson & ",'" & _ CharacterReplace(strCorrectiveMeasuresSummary) & "'," & _ intPrimaryRootCause & "," & _ intPrimaryRootCause_Type & ",'" & _ dtTimeStamp_EventDetail & "'," & _ bolOverRide & "" .CommandType = adCmdText Set grstRecordset_Temp = .Execute End With Set EventDetails_Update = grstRecordset_Temp ExitFX: If IsObject(grstRecordset_Temp) Then Set grstRecordset_Temp = Nothing Exit Function ErrorTrap: Select Case err.Number Case -2147217900 err.Raise vbObjectError + 855, _ "dbIRS Viewer", _ "Application failed updating the event details because another " & _ "user updated the record after you opened it." Case Else err.Raise vbObjectError + 865, _ "dbIRS Viewer", _ "Application failed updating the event details for an unknown reason." _ & vbCrLf & vbCrLf & "Please contact support, " & gstrSupportInfo & "." End Select GoTo ExitFX End Function Private Function CharacterReplace(ByVal strString As String) As String ''replace illegal strings values with underscore ''changes original string 'replace single apostrophe strString = Replace(strString, Chr(39), Chr(39) & Chr(39)) 'replaces double apostrophe 'strString = Replace(strString, Chr(34), Chr(34)) CharacterReplace = strString End Function