Link to home
Start Free TrialLog in
Avatar of Karen Schaefer
Karen SchaeferFlag for United States of America

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.

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

Open in new window

I am getting the Type mismatch error messages and the Call See line #58 does not execute the function.
Avatar of Eric Sherman
Eric Sherman
Flag of United States of America image

Where is this function stored ?

Call ISCenter_Data_Load_Routine(ReportName, ModName, ProcName, RecCt, sErr)


ET
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.
Avatar of Karen Schaefer

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).
'---------------------------------------------------------------------------------------
' 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

Open in new window


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

Open in new window


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
Avatar of Karen Schaefer
Karen Schaefer
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Please close this out - Trying a different approach and will repost the new question.

Thanks for your input.