Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
View Poll Results: HelpMe
afa 0 0%
afda 0 0%
Voters: 0. You may not vote on this poll

Reply
 
Thread Tools Rating: Thread Rating: 4 votes, 5.00 average. Display Modes
Old 10-07-2013, 02:04 PM   #1
kfschaefer1
Newly Registered User
 
Join Date: Oct 2013
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
kfschaefer1 is on a distinguished road
Calling Function W/parameters From Within Another Function To Create Event Logger Gen

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

kfschaefer1 is offline   Reply With Quote
Reply

Tags
access 2003 , sql 2008

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
"Undefined Function" when calling function in query PaulA Queries 4 11-22-2010 07:13 AM
Label OnClick Event is calling Function Twice modest Modules & VBA 1 07-31-2006 08:50 AM
Function calling accessjpm Forms 8 08-10-2004 11:13 AM
Help my function and calling this function mdbBound Modules & VBA 6 04-28-2004 10:29 AM
[SOLVED] Calling a function Leigh Forms 1 02-04-2000 08:12 PM




All times are GMT -8. The time now is 10:25 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World