Enterprise Error Management- Setup phase

Part 1

Private Sub Form_Load()


On Error Resume Next
DoCmd.Hourglass True
Me.Visible = False
DoCmd.OpenForm "Splash"
If Not gbApp_SetupOccurred Then
    Call StartUp    'define public variables because processing was interrupted
    '#If APP_MODE = DEBUG_MODE Then
    '    MsgBox "Just defined public variables"
    '#End If

End If


DoCmd.OpenForm "Preferences", acNormal, windowmode:=acHidden
Call Login
Me.Visible = True
DoCmd.Hourglass False
End Sub


Public Sub StartUp()
'will rename to init globals
'will read from INI file to get path for executable
Dim objCatalog As Object    'ADOX.Catalog
Dim objTable As Object      'ADOX.Table
Dim strAppPath As String
On Error Resume Next


Set objCatalog = CreateObject("ADOX.Catalog")
'Set objCatalog = New ADOX.Catalog
Set objCatalog.ActiveConnection = CurrentProject.Connection

'Set objTable = New ADOX.Table
Set objTable = CreateObject("ADOX.Table")
objTable.Name = "DailyWork"
Set objTable.ParentCatalog = objCatalog
Set objTable = objCatalog.Tables("DailyWork")
strAppPath = JustPathfromFileName(objTable.Properties("Jet OLEDB:Link DataSource"))
Application.TempVars.Add "AppPath", strAppPath
gbApp_SetupOccurred = True

'getAppPath()
'Call SetErrorFilePath(CurrentProject.Path) 'log errors here

Call SetErrorFilePath(strAppPath) 'log errors here

gbDEBUG_MODE = Len(Dir$(AddBS(CurrentProject.Path) & "debug.ini")) > 0

'gsREG_APP=
'APP_NAME = "CPLI App"

End Sub


========================================================
===============   modGeneral code
========================================================


Public Function FileExists(sFullName As String) As Boolean
    Dim bExists As Boolean
    Dim nLength As Integer
 
    nLength = Len(Dir(sFullName))
 
    If nLength > 0 Then
        bExists = True
    Else
        bExists = False
    End If
 
    FileExists = bExists
End Function


Public Function GetShortName(sLongName As String) As String
    Dim sPath As String
    Dim sShortName As String
 
    BreakdownName sLongName, sShortName, sPath

    GetShortName = sShortName
End Function

Public Function JustPathfromFileName(sLongName As String) As String
Dim sPath As String
Dim sShortName As String

BreakdownName sLongName, sShortName, sPath

JustPathfromFileName = sPath
End Function


Sub BreakdownName(sFullName As String, _
                  ByRef sname As String, _
                  ByRef sPath As String)
               
    Dim nPos As Integer
 
    ' Find out where the file name begins
    nPos = FileNamePosition(sFullName)
 
    If nPos > 0 Then
        sname = Right(sFullName, Len(sFullName) - nPos)
        sPath = Left(sFullName, nPos - 1)
    Else
        'Invalid sFullName - don't change anything
    End If
End Sub

Public Variables from modError
Public Const glHANDLED_ERROR As Long = 9999
Public Const glUSER_CANCEL As Long = 18

Public gstrERROR_LOG_PATH As String
Public gbDEBUG_MODE As Boolean
Private Const msSILENT_ERROR As String = "UserCancel"
Private Const msFILE_ERROR_LOG As String = "Error.log"

Public Sub SetErrorFilePath(strPath As String)
'test if folder exists
If Len(strPath) = 0 Then Exit Sub
If Right$(strPath, 1) = "\" Then strPath = Left(strPath, Len(Trim(strPath)) - 1)
gstrERROR_LOG_PATH = strPath
End Sub

'===========================================================
'Author         :William DeCastro
'Created        :08/31/2009
'Last modified  :08/31/2009 1.0 Beta
'Objective      :will Save/update talent plus rate detail to the
'               appropriate tables
'
'Arguments      :
'Sample Call    :
'Called By      :
'===========================================================
Function Login() As Boolean
Const ssource As String = "Login"
Dim varUserAccessLevel As Variant
Dim strCurrentUser As String

On Error GoTo ErrorHandler

strCurrentUser = getWindowsUserId()
varUserAccessLevel = DLookup("UserAccessLevel", "SecurityUser", "[Name]=" & "'" & strCurrentUser & "'")
If IsNull(varUserAccessLevel) Then
    TempVars.Add "UserAccessLevel", UserRole.ReadOnly
    MsgBox "You currently are not in the system and will therefore be assigned minimal rights as a Read Only user.", _
        vbInformation
    Login = True
Else
    TempVars.Add "UserAccessLevel", CInt(varUserAccessLevel)
    Login = True
End If
 
ExitProc:
    On Error Resume Next
    Exit Function

ErrorHandler:
   
    If bCentralErrorHandler(msMODULE, ssource) Then
        Stop
        Resume
    Else
        Resume ExitProc
    End If

End Function



Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetComputerName _
Lib "kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Function getWindowsUserId() As String
' Returns the network login name.
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = GetUserName(strUserName, lngLen)
If lngX <> 0 Then
    getWindowsUserId = Left$(strUserName, lngLen - 1)
Else
    getWindowsUserId = "Unknown"
End If

End Function


Public Function GetWorkstationId() As String
' Retrieve the name of the computer.
Const acbcMaxComputerName = 15
Dim strBuffer As String
Dim lngLen As Long
strBuffer = Space(acbcMaxComputerName + 1)
lngLen = Len(strBuffer)
If CBool(GetComputerName(strBuffer, lngLen)) Then
    GetWorkstationId = Left$(strBuffer, lngLen)
Else
    GetWorkstationId = ""
End If
End Function

+++++++++++++++++++++++++++++++

Splash code

Private Sub Form_Load()

On Error Resume Next

Me.lblReleaseDate.Caption = Format(DLookup("VersionDate", "tsysconfig_Local"), "General Date")

Me.lblVersion.Caption = "V" & DLookup("VersionNumber", "tsysconfig_Local")

End Sub

Private Sub Form_Timer()

DoCmd.Close acForm, Me.Name

End Sub

++++++++++++++++++++++++++++++++++++++

Public Enum UserRole

    ReadOnly = 1

    System = 2

    NewBusiness = 3

    MarginAnalyst = 4

    MarginAnalystsSupervisor = 5

    Admin = 8

    SuperAdmin = 10

End Enum