Karen Schaefer
asked on
Call a Function and passing parameters - TypeMismatch issue
how do i call this Function and use the variables for the parameters.
i need to call this function in the various codes to capture the events that happen during the processing of the code.
i need to call this function in the various codes to capture the events that happen during the processing of the code.
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 dbs As Database
Dim rs As Recordset
Dim ReportName As String
Dim ReportDesc As String
Dim Msg, Desc As String
' 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
Dim lngRC_Import As Long
Dim lngRC_BeforeAppend As Long
Dim lngRC_AfterAppend As Long
Dim sErr As String
Dim rs1, rs2, rs3 As Recordset
Dim ct As Long
Const cstrImportTableName As String = "tblInvoices_Import"
Const cstrAccumulatorName As String = "tblInvoicesData"
On Error GoTo ErrorHandler
If RptName <> "" Then
ReportName = RptName
ReportDesc = rptDesc
Else
ReportName = JobList.CurrentJob
ReportDesc = JobList.CurrentJobDesc
End If
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblSelectionMenu")
rs.FindFirst "RptName = '" & ReportName & "'"
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
Call ISCenter_Data_Load_Routine(ReportName, ModName, ProcName, RecCt, sErr)
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
Set rs1 = dbs.OpenRecordset("tblUpdateLog")
Set rs2 = dbs.OpenRecordset("tblInvoices_Import")
rs1.Edit
rs1.Fields("Invoices") = date
rs1.Update
rs2.MoveLast
ct = Format(rs2.RecordCount, "###,###")
EndTime = Time
RunTime = (EndTime - StartTime)
RunTime = Format(RunTime, "hh:mm:ss")
Set rs3 = dbs.OpenRecordset("tblDailyLog")
rs3.FindFirst "Name = '" & ReportName & "'"
rs3.Edit
rs3.Fields("UpdateDate") = date
rs3.Fields("RunTime") = RunTime
rs3.Update
RecCt = ct
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 = ProcName & " -- " & Err.Number & ". " & Err.Description
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'49KXS - 8/22/2013
'Added code to update a new Error handling method/Log wihin SQL - so the Customer may
'review the log should an issues arise.
'Variables of the module
'@EventName = ReportName
'@ModuleName = ModName
'@ProcedureName = ProcName
'@ErrorMessage =Err.Number & ". " & Err.Description
Call ISCenter_Data_Load_Routine(ReportName, ModName, ProcName, RecCt, sErr)
Debug.Print ReportName, " & vbcrlf & ModName, " & vbCrLf & ProcName, " & vbcrlf & RecCt," & vbCrLf & sErr; ""
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Call HandleError(ErrNumber:=Err.Number, _
ErrDescription:=Err.Description, _
ErrTitle:=Err.source, _
module:=MODNAME, _
Procedure:=ProcName)
mWriteLogIndent 2, sErr
Resume ExitHandler
End Sub
I am getting the Type mismatch error messages and the Call See line #58 does not execute the function.
Yes, please show the function definition. You can right click on the function name, then select definition, if you don't know where it is.
ASKER
Please note i have resolved the issue with the parameters(variables) by Changing the Function Type from Boolean to String.
However, i am now having an issue with closing of the Connection (termination) i need to keep the connection open so that the Eventid that is generated by the SQLConnection remains open, for the CloseLogRecord of the code. The Eventid is created when the Function is Called from within the processing Code (Invoiceload).
i have been playing with When the Eventid is set by commenting it out in the open or Close record code - A new value is set in the 'OpenLogRecord', but since the connection is closed then it reverts to Zero. how Do i keep the newly created Eventid?
thanks,
K
However, i am now having an issue with closing of the Connection (termination) i need to keep the connection open so that the Eventid that is generated by the SQLConnection remains open, for the CloseLogRecord of the code. The Eventid is created when the Function is Called from within the processing Code (Invoiceload).
'---------------------------------------------------------------------------------------
' Procedure : ISCenter_Data_Load_Routine
' Author : 49kxs/49mwg
' Date : 9/5/2013
' Purpose : Records the Major events from within the Modules and updates the event log
' within the SQL ISCenter_Monitor.USP_Log_ISCenter_Event.
'---------------------------------------------------------------------------------------
Public Function ISCenter_Data_Load_Routine(ByVal ReportName As String, _
ByVal ModName As String, _
ByVal ProcName As String, _
Optional ByVal RecCt As Long, _
Optional ByVal sErr As String) As String
Dim objLog As New clsISCenterEventLogger
On Error GoTo ISCenter_Data_Load_Routine_Error
If objLog.IsOpen = False Then
objLog.OpenLogRecord ReportName:=ReportName, _
ModName:=ModName, _
ProcName:=ProcName
Debug.Print EventID, ReportName, ModName, ProcName, RecCt, sErr
Else
objLog.CloseLogRecord RowsAffected:=RecCt, _
ErrMsg:=sErr, _
AdditionalInfo:="Tested using VBA class", _
StepSucceeded:=1
End If
On Error GoTo 0
Exit Function
ISCenter_Data_Load_Routine_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure ISCenter_Data_Load_Routine of Module basEventLogger"
End Function
Option Compare Database
Option Explicit
Const MODNameLocal = "clsISCenterLogger"
Const defConnString As String = "Driver={SQL Server};Server=AQL02;database=TRACI_ANALYTICS;UID=ISCenterLogger;PWD=DataLumberjack"
Const defSproc As String = "ISCenter_Monitor.usp_log_ISCenter_Event"
Private EventID As Long
Private CmdStr As String
'ADODB variables
Private conn As ADODB.Connection
Private cmd As ADODB.Command
' Note that the ConnectionString property uses the [conn] object,
' which was instantiated in the constructor (the class INITIALIZE() event.)
'---------------------------------------------------------------------------------------
' Procedure : ConnectionString
' Author : 49kfs/49mwg
' Date : 9/5/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Property Let ConnectionString(pCS As String)
conn.ConnectionString = pCS
End Property
'---------------------------------------------------------------------------------------
' Procedure : ConnectionString
' Author : 49kfs/49mwg
' Date : 9/5/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Property Get ConnectionString() As String
ConnectionString = conn.ConnectionString
End Property
'---------------------------------------------------------------------------------------
' Procedure : IsOpen
' Author : 49yar
' Date : 9/5/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Property Get IsOpen() As Boolean
IsOpen = IIf(EventID = 0, False, True)
End Property
'---------------------------------------------------------------------------------------
' Procedure : Class_Initialize
' Author : 49kfs/49mwg
' Date : 9/5/2013
' Purpose : Constructor; called whenever you initialize an object of this class.
' Initialize variables. Note that we set a default connection string, to save you the bother
' of setting it each time you instantiate this object. You can, of course, set it to
' something different.
'
' If VBA implemented fully-functional objects, the constructor could accept parameters,
' and automatically establish a connection and open a log record at this time.
' Even better, the constructor could accept ConnectionString as a parameter, allowing you
' to specify the connection string when you create the object. Like this:
'
' Dim objISlog as new clsISCenterLogger(myConnectionString)
'
' That is how you would do it in C#. But VBA does not allow this. Pity.
'---------------------------------------------------------------------------------------
'
Private Sub Class_Initialize()
Const ProcNameLocal = "Class_Initialize"
On Error GoTo PROC_ERROR
'EventID = 0
CmdStr = defSproc
Set conn = New ADODB.Connection
Set cmd = New ADODB.Command
conn.ConnectionString = defConnString
GoTo PROC_EXIT
PROC_ERROR:
MsgBox Err.Description, vbExclamation, MODNameLocal + "::" + ProcNameLocal + " Error"
Resume PROC_EXIT
PROC_EXIT:
End Sub
'---------------------------------------------------------------------------------------
' Procedure : OpenLogRecord
' Author : 49kfs/49mwg
' Date : 9/5/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Function OpenLogRecord(ReportName As String, ModName As String, ProcName As String) As Boolean
Const ProcNameLocal = "OpenLogRecord"
On Error GoTo PROC_ERROR
Dim retcode As Boolean
retcode = True
EventID = 0
conn.Open
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = CmdStr
'.NamedParameters = True ' Commented out due to not currently available in 2003
.Parameters("@EventName").Value = ReportName
.Parameters("@ModuleName").Value = ModName
.Parameters("@ProcedureName").Value = ProcName
.Execute
End With
EventID = cmd.Parameters("@RETURN_VALUE").Value
retcode = True
GoTo PROC_EXIT
PROC_ERROR:
MsgBox Err.Description, vbExclamation, MODNameLocal + "::" + ProcNameLocal + " Error"
retcode = False
Resume PROC_EXIT
PROC_EXIT:
On Error Resume Next
'conn.Close
End Function
'---------------------------------------------------------------------------------------
' Procedure : CloseLogRecord
' Author : 49kfs/49mwg
' Date : 9/5/2013
' Purpose :
'---------------------------------------------------------------------------------------
'
Public Function CloseLogRecord(RowsAffected As Long, ErrMsg As String, _
AdditionalInfo As String, StepSucceeded As Integer) As Boolean
Const ProcNameLocal = "CloseLogRecord"
On Error GoTo PROC_ERROR
Dim retcode As Boolean
retcode = True
conn.Open
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = CmdStr
.Parameters("@EventID").Value = EventID
.Parameters("@ErrorMessage").Value = ErrMsg
.Parameters("@StepSucceeded").Value = StepSucceeded
.Parameters("@AffectedRows").Value = RowsAffected
.Parameters("@AdditionalInfo").Value = AdditionalInfo
.Execute
End With
retcode = True
GoTo PROC_EXIT
PROC_ERROR:
MsgBox Err.Description, vbExclamation, MODNameLocal + "::" + ProcNameLocal + " Error"
retcode = False
Resume PROC_EXIT
PROC_EXIT:
On Error Resume Next
conn.Close
End Function
'---------------------------------------------------------------------------------------
' Procedure : Class_Terminate
' Author : 49yar
' Date : 9/5/2013
' Purpose : Destructor. Executes when the object is destroyed.
'---------------------------------------------------------------------------------------
'
Private Sub Class_Terminate()
On Error Resume Next
conn.Close
Set conn = Nothing
Set cmd = Nothing
End Sub
i have been playing with When the Eventid is set by commenting it out in the open or Close record code - A new value is set in the 'OpenLogRecord', but since the connection is closed then it reverts to Zero. how Do i keep the newly created Eventid?
thanks,
K
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Please close this out - Trying a different approach and will repost the new question.
Thanks for your input.
Thanks for your input.
Call ISCenter_Data_Load_Routine
ET