VBA Snippets


Error_Handle

Handles the error and displays the relevant message reporting what error has occurred.
Public Sub Error_Handle( _
ByVal sModuleName As String, _
ByVal sRoutineName As String, _
ByVal sErrorNo As String, _
ByVal sErrorDescription As String, _
Optional ByVal sErrorMessage As String = "")

Dim sMessage As String
On Error GoTo ErrorHandler
If (Len(sErrorMessage) > 0) Then
sMessage = "Unable to " & sErrorMessage
Else
sMessage = sErrorNo & " : " & sErrorDescription
End If
If (g_bERROR = False) Then
Application.ScreenUpdating = True
Application.StatusBar = False
Call MsgBox(sMessage, _
vbCritical, g_sCOMPANYNAME & " (" & g_sVERSION & ") " & sModuleName & " - " & sRoutineName)
g_bERROR = True
End If
If g_bERROR_LOGTOFILE = True Then
Call LogFile_WriteError(sModuleName, sRoutineName, sMessage)
End If
Exit Sub

ErrorHandler:
Application.ScreenUpdating = True
Call MsgBox("Unable to display the appropriate error message." & vbCrLf & vbCrLf & _
"Please send an e-mail to 'support@bettersolutions.com'", _
vbInformation Or vbOKOnly, _
"(" & g_sVERSION & ") " & "modGeneral - Error Handle")
End
End Sub
'****************************************************************************************
Public Sub Error_Handle( _
ByVal sProcedureName As String, _
ByVal sModuleName As String, _
ByVal smessage As String)

On Error GoTo AnError
Call MsgBox("Unable to " & smessage, _
vbInformation, _
sProcedureName & " [" & sModuleName & "]")
If gbDEBUG_ERRMSG = False Then End

Exit Sub
AnError:
Call MsgBox("Unable to display the appropriate error message." & vbCrLf & vbCrLf & _
"Please send an e-mail to Better Solutions." & vbCrLf & _
"'support@bettersolutions.com'", _
vbInformation Or vbOKOnly, "Error Handle")
End
End Sub
'****************************************************************************************
Public Sub Error_Handle( _
ByVal sModuleName As String, _
ByVal sRoutineName As String, _
ByVal sErrorNo As String, _
ByVal sErrorDescription As String, _
Optional ByVal sErrorMessage As String = "")

Dim sMessage As String

On Error GoTo AnError

sMessage = sErrorNo & " : " & sErrorDescription

If (gbERROR = False) Then
Application.ScreenUpdating = True
Application.StatusBar = False

Call MsgBox(sMessage, _
vbCritical, "Graphex (" & g_sVERSION_NO & ") " & sModuleName & " - " & sRoutineName)

gbERROR = True

End If

If gbERROR_LOGTOFILE = True Then
Call LogFile_WriteError(sModuleName, sRoutineName, sMessage)
End If

Exit Sub
AnError:
Call MsgBox("Unable to display the appropriate error message." & vbCrLf & vbCrLf & _
"Please send an e-mail to 'rpod_tech'", _
vbInformation Or vbOKOnly, _
"(" & g_sVERSION_NO & ") " & "modGeneral - Error Handle")
End
End Sub

Error_HowFatal

Determines how fatal an error is and takes the appropriate action.
Public Sub Error_HowFatal( _
ByVal iHowFatal As Integer)

On Error GoTo AnError

Select Case iHowFatal
Case 1: Call Macro_SettingsReset
End
Case 2: Call Frm_Choice("", "Would you like to continue ?")
' Message box equivalent ??
If gbChoice = False Then
Call Macro_SettingsReset
End
End If
Case 3:
End Select

If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Error_HowFatal", msMODULENAME, 1,
"determine how fatal the error was and take the appropriate action")
End Sub

LogInformation

Public Sub User_LogInformation( _
ByVal sDocumentName as string, _
ByVal sFolderPath As String, _
ByVal sFileName As String)

Dim slogfilepath As String
Dim slogmessage As String
Dim ifilenum As Integer

slogfilepath = sFolderPath & sFileName

slogmessage = "Date Accessed: " & Format(Date, "dd mmm yyyy hh:mm:ss")
slogmessage = vbTab
slogmessage = "FileName: " & sDocumentName
slogmessage = vbTab
slogmessage = "Excel UserName: " & Application.UserName
slogmessage = vbTab
slogmessage = "Windows UserName: " & ReturnUserName
slogmessage = vbCrLf

ifilenum = FreeFile ' next file number

' creates the file if it doesn't exist
Open slogfilepath For Append As #ifilenum

' write information at the end of the text file
Print #ifilenum, slogmessage

' close the file
Close #ifilenum
End Sub

© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top