I have code that will update SQL tables and uses a Stored Procedures to gather the information. The following code works successfully and updates the SQL table.
I am looking for assistance in now using these functions to capture information regarding the processeing of the databases. I need to capture the rowcount of each query being used with the function, the Function/Procedure Name, Error handling etc.
I am unsure on where to place the CALL of the function and the proper syntax to capture the necessary information.
The following is the Event handling Code/Classes.
CODE
Option Compare Database
Option Explicit
'Compiled in Access 2003, 04-Sept-2013
'REFERENCES NEEDED:
'
'Visual Basic For Applications
'Microsoft Access 11.0 Object Library
'Microsoft DAO 3.6 Object Library
'OLE Automation
'Microsoft ActiveX Data Objects 2.8 Library
Private Const sproc As String = "ISCenter_Monitor.usp_log_ISCenter_Event"
Private Const connstr = _
"Driver={SQL Server};Server=AQL02;database=TESTDB;UID=******;PWD=****"
Public Sub EventLog_Open_And_Close_Using_Class()
On Error GoTo PROC_ERROR
Dim objLog As New clsISCenterLogger_EventLog
'Set the ThrowErrors property to one of the following values when running under automation:
' eIgnoreErrors
' eThrowOnly
'
objLog.ThrowErrors = eRaiseOnly
If objLog.IsOpen = False Then objLog.OpenLogRecord
If objLog.IsOpen = True Then _
objLog.CloseLogRecord RowsAffected:=999, _
ErrMsg:="EventLog Error Message", _
AdditionalInfo:="EventLogged using VBA class", _
StepSucceeded:=1
GoTo PROC_EXIT
PROC_ERROR:
MsgBox err.Description
Resume PROC_EXIT
PROC_EXIT:
End Sub
Private Sub EventLog_Open_And_Close()
On Error GoTo PROC_ERROR
Dim eventid As Long
Dim RowsAffected As Long
Dim ErrorMessage As String
Dim AdditionalInfo As String
Dim StepSucceeded As Integer
RowsAffected = 999
ErrorMessage = "EventLog Error Message #003"
AdditionalInfo = "EventLoging from MS Access VBA/ADODB"
StepSucceeded = 1
eventid = EventLog_open_log_record()
If eventid <> 0 Then EventLog_close_log_record eventid, RowsAffected, _
ErrorMessage, AdditionalInfo, StepSucceeded
MsgBox "EventID was " + CStr(eventid)
GoTo PROC_EXIT
PROC_ERROR:
MsgBox err.Description
Resume PROC_EXIT
PROC_EXIT:
End Sub
Private Function EventLog_open_log_record() As Long
On Error GoTo PROC_ERROR
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
'Dim parm As ADODB.Parameter
Dim eventid As Long
eventid = 0
conn.ConnectionString = connstr
conn.Open
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = sproc
.NamedParameters = True
'Dim pEventLog As ADODB.Parameter
'For Each pEventLog In cmd.Parameters
' Debug.Print pEventLog.Name
'Next pEventLog
.Parameters("@EventName").value = "EventLog Event"
.Parameters("@ModuleName").value = "EventLog Module"
.Parameters("@ProcedureName").value = "EventLog Procedure"
End With
'Set parm = cmd.CreateParameter("@ReturnCode", adInteger, , adParamReturnValue)
'cmd.Parameters.Append parm
cmd.Execute
eventid = cmd.Parameters("@RETURN_VALUE").value
GoTo PROC_EXIT
PROC_ERROR:
MsgBox err.Description
Resume PROC_EXIT
PROC_EXIT:
On Error Resume Next
conn.Close
EventLog_open_log_record = eventid
End Function
Private Sub EventLog_close_log_record(eventid As Long, RowsAffected As Long, ErrMsg _
As String, AdditionalInfo As String, StepSucceeded As Integer)
On Error GoTo PROC_ERROR
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
conn.ConnectionString = connstr
conn.Open
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = sproc
.NamedParameters = True
.Parameters("@EventID").value = eventid
.Parameters("@ErrorMessage").value = ErrMsg
.Parameters("@StepSucceeded").value = StepSucceeded
.Parameters("@AffectedRows").value = RowsAffected
.Parameters("@AdditionalInfo").value = AdditionalInfo
End With
cmd.Execute
GoTo PROC_EXIT
PROC_ERROR:
MsgBox err.Description
Resume PROC_EXIT
PROC_EXIT:
On Error Resume Next
conn.Close
End Sub
The following is the function I am wanting to modify to include the event logger code:
CODE
Public Const csPathEDIInvoices = "C:\Development\InvoiceLoadTest"
Public Const csPathImportData = "C:\Development\InvoiceLoadTest"
Public Sub InvoicesLoad(Optional ByVal JobList As Form_frmjobs = Nothing, _
Optional ByVal Confirm As Boolean = True, _
Optional ByVal RptName As String = "", _
Optional ByVal rptDesc As String = "")
Const ProcName = "InvoicesLoad"
'' 07/25/2008 49rsc added logging
'' 02/12/2010 49rsc Call InvoicesLoad_RunSQLAgentJob
Dim ReportName As String
Dim ReportDesc As String
On Error GoTo ErrorHandler
If RptName <> "" Then
ReportName = RptName
ReportDesc = rptDesc
Else
ReportName = JobList.CurrentJob
ReportDesc = JobList.CurrentJobDesc
End If
Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblSelectionMenu")
rs.FindFirst "RptName = '" & ReportName & "'"
Dim Msg, Desc As String
Msg = "Do you want to proceed with your selection: " & ReportName & "?"
Desc = Msg & vbCrLf & vbCrLf & "REPORT/TOOL DESCRIPTION:" & vbCrLf & rs.Fields("Description")
If Confirm Then
If MsgBox(Desc, vbYesNo, "Update/Report Selection") = vbNo Then
Exit Sub
End If
End If
' 3/31/05 49mam: Change SendKeys to Automation
'---------------------------------------------
Dim xla As Excel.Application
Dim xlb As Excel.Workbook
Dim xls As Excel.Worksheet
Dim sFiles As String ' source filename
Dim sFileD As String ' destination filename
Dim StartTime As Date
Dim EndTime As Date
Dim RunTime As String
Const cstrImportTableName As String = "tblInvoices_Import"
Const cstrAccumulatorName As String = "tblInvoicesData"
Dim lngRC_Import As Long
Dim lngRC_BeforeAppend As Long
Dim lngRC_AfterAppend As Long
Dim sErr As String
StartTime = Time
sFiles = csPathEDIInvoices & Format(date, "YYYYMMDD") & " EDIInvoices.xls"
sFileD = csPathImportData & "InvoiceData.xls"
' delete destination file, if it exists
On Error Resume Next
Kill sFileD
On Error GoTo ErrorHandler
' copy source file to destination file
If Dir(sFiles) = "" Then
err.Raise Number:=clErrBoeingInvoicesNoData, _
Description:=Replace(csErrBoeingInvoicesNoData, "%srcfile%", sFiles)
End If
On Error Resume Next
FileCopy sFiles, sFileD
If err Then
sErr = csErrFileCopy
sErr = Replace(sErr, "%source%", sFiles)
sErr = Replace(sErr, "%dest%", sFileD)
err.Raise Number:=clErrFileCopy, _
Description:=sErr
End If
On err GoTo ErrorHandler
' launch Excel and open destination file
Set xla = New Excel.Application
Set xlb = xla.Workbooks.Open(FileName:=sFileD)
Set xls = xlb.Worksheets(1)
' format report
'====================================================================
' CODE CHANGE 18-July-2012 by 49mwg
FormatReport_ThrowErrors (xls)
'Call FormatReport(xls)
'====================================================================
' re-format column "BH" (format as Date and remove Time portion from cell values)
With xls.Range("BH:BH")
.NumberFormat = "mm/dd/yy"
.Replace " *", ""
End With
' save and close
xlb.Save
xlb.Close False
xla.Quit
'---------------------------------------------
DoCmd.SetWarnings (False)
DoCmd.OpenQuery ("qryCLEAR:Invoices_Import")
'Imports S:\49bse\Invoices Sent To Boeing\Edi\InvoiceUpdate.xls
DoCmd.TransferSpreadsheet acImportDelim, , "tblInvoices_Import", csPathImportData & "InvoiceData.xls", True
mWriteLog_RecordCounts cstrImportTableName, "Records imported", lngRC_Import
mWriteLog_RecordCounts cstrAccumulatorName, "Accumulator records before append", lngRC_BeforeAppend
'Appends imported data into the database
DoCmd.OpenQuery ("qryAPPEND:InvoiceData")
mWriteLog_RecordCounts cstrAccumulatorName, "Accumulator records after append", lngRC_AfterAppend
'' 02/12/2010
Call InvoicesLoad_SQLJob_InvoiceData2
DoCmd.SetWarnings (True)
'Logs update time in tblUpdateLog
Dim rs1, rs2 As Recordset
Set rs1 = dbs.OpenRecordset("tblUpdateLog")
Set rs2 = dbs.OpenRecordset("tblInvoices_Import")
rs1.Edit
rs1.Fields("Invoices") = date
rs1.Update
Dim ct As String
rs2.MoveLast
ct = Format(rs2.RecordCount, "###,###")
EndTime = Time
RunTime = (EndTime - StartTime)
RunTime = Format(RunTime, "hh:mm:ss")
Dim rs3 As Recordset
Set rs3 = dbs.OpenRecordset("tblDailyLog")
rs3.FindFirst "Name = '" & ReportName & "'"
rs3.Edit
rs3.Fields("UpdateDate") = date
rs3.Fields("RunTime") = RunTime
rs3.Update
If Confirm Then SafeMsgBox "Update complete." & vbCrLf & vbCrLf & ct & " records imported." & vbCrLf & "Run Time: " & RunTime, , "Database Information"
ExitHandler:
On Error Resume Next
xlb.Close False
xla.Quit
Set xls = Nothing
Set xlb = Nothing
Set xla = Nothing
Exit Sub
ErrorHandler:
DoCmd.Hourglass (False)
DoCmd.SetWarnings (True)
sErr = "InvoicesLoad() -- " & err.Number & ". " & err.Description
Call HandleError(ErrNumber:=err.Number, _
ErrDescription:=err.Description, _
ErrTitle:=err.source, _
module:=MODNAME, _
Procedure:=ProcName)
mWriteLogIndent 2, sErr
Resume ExitHandler
End Sub
Stored Procedure
CODE
USE [TRACI_ANALYTICS]
GO
/****** Object: StoredProcedure [ISCenter_Monitor].[usp_log_ISCenter_Event] Script Date: 10/04/2013 13:27:56 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER PROCEDURE [ISCenter_Monitor].[usp_log_ISCenter_Event]
(
@EventID integer = NULL
, @EventName nvarchar(255) = NULL
, @ModuleName nvarchar(255) = NULL
, @ProcedureName nvarchar(255) = NULL
, @EventStep nvarchar(255) = NULL
, @EventStepParentID integer = NULL
, @AffectedRows integer = NULL
, @StepSucceeded bit = NULL
, @ErrorMessage nvarchar(512) = NULL
, @AdditionalInfo nvarchar(1024) = NULL
)
AS BEGIN
--================================================================================
========
--
-- SCRIPT: usp_log_ISCenter_Event
--
-- AUTHOR: --
-- DESCRIPTION: Logs an event to ISCenter_Monitor].[ISCenter_EventLog]
--
-- The following parameters are used only when an event entry is being created.
-- These parameters will be ignored when closing an event; no error will be raised.
-- (@EventID is NULL):
-- @EventName
-- @ModuleName
-- @ProcedureName
-- @EventStep
-- @EventStepParentID
--
-- CHANGE HISTORY
-- DATE BY ISSUE # DESCRIPTION
-- ------------ ------- --------------- -----------------------------------------------------------
-- 27-June-2013 49mwg Created sproc.
-- 13-Sept-2013 49mwg Update [AdditionalInfo]
--
--================================================================================
========
SET NOCOUNT ON
DECLARE @OpenEventID integer
DECLARE @EndDate datetime
DECLARE @RETVAL integer
BEGIN TRY
SET @RETVAL = 0
IF @EventID IS NULL
BEGIN
-- Creating a new event log entry
-- If @EventStepParentID is provided, verify that the ParentID exists.
IF @EventStepParentID IS NOT NULL
BEGIN
SELECT @OpenEventID = EventID
FROM [ISCenter_Monitor].[ISCenter_EventLog]
WHERE EventID = @EventStepParentID
IF @OpenEventID IS NULL
BEGIN
RAISERROR ( N'A parent event was specified (EventID = %d), but no matching EventID was found in the event table.'
, 11 -- severity
, 1 -- state
, @EventStepParentID
)
END
END
BEGIN
INSERT INTO [ISCenter_Monitor].[ISCenter_EventLog]
(EventName, EventStartDate, ModuleName, ProcedureName, EventStep, EventStepParentID)
SELECT @EventName
, GETDATE()
, @ModuleName
, @ProcedureName
, @EventStep
, @EventStepParentID
SET @RETVAL = SCOPE_IDENTITY()
END
RAISERROR ( 'Test Error - Thrown intentionally!'
, 11 -- severity
, 1 -- state
, @EventID
)
END
ELSE BEGIN
-- Closing an existing event log entry
-- Verify that the specified @EventID exists.
IF @StepSucceeded IS NULL
BEGIN
RAISERROR ( N'@StepSucceeded is NULL. You must specify SUCCEED (1) or FAIL (0).'
, 11 -- severity
, 1 -- state
, @EventID
)
END
SELECT @OpenEventID = EventID,
@EndDate = EventEndDate
FROM [ISCenter_Monitor].[ISCenter_EventLog]
WHERE EventID = @EventID
IF @OpenEventID IS NULL
BEGIN
RAISERROR ( N'The specified event (EventID = %d) was not found in the event table.'
, 11 -- severity
, 1 -- state
, @EventID
)
END
IF @EndDate IS NOT NULL
BEGIN
RAISERROR ( N'The specified event (EventID = %d) already has an end date specified. This event may not be updated.'
, 11 -- severity
, 1 -- state
, @EventID
)
END
UPDATE [ISCenter_Monitor].[ISCenter_EventLog]
SET EventEndDate = GETDATE()
, AffectedRows = @AffectedRows
, StepSucceeded = @StepSucceeded
, ErrorMessage = @ErrorMessage
, AdditionalInfo = @AdditionalInfo
WHERE EventID = @EventID
RAISERROR ( 'Test Error - Thrown intentionally!'
, 11 -- severity
, 1 -- state
, @EventID
)
END
END TRY
BEGIN CATCH
DECLARE @ErrorMsg NVARCHAR(4000);
DECLARE @ErrorSeverity INT;
DECLARE @ErrorState INT;
SELECT
@ErrorMsg = ERROR_MESSAGE(),
@ErrorSeverity = ERROR_SEVERITY(),
@ErrorState = ERROR_STATE();
RAISERROR (@ErrorMsg, -- Message text.
@ErrorSeverity, -- Severity.
@ErrorState -- State.
);
RETURN -1
END CATCH
RETURN @RETVAL
SET NOCOUNT OFF
END
Again, I am looking for help with calling the EventLogger code and including the correct paramenters to be passed to the SQL Stored procedure.
Note: the code EventLogger code is currently set to deliver a failed msg dialog.
Thanks,
karen