This is my errorhandling code for ADP's (public_Error_message(loc_str_error_message_text As String)) .Yes i know its better to write it too a txt file but with this code every time a user has an error i can see it
in my main menu i have a little code witch looks if there are any new errors and tells me how many from wich user and on what computer
there are three functions that come with it namely local_control_for_single_quotes(string),networkusername and computername
First i need a table with these fields
form = string to set the name of the form wich produced the error or report
error message text = string to set the text of the error message
error = string for the shorter errormessage
errornumber = string for the errornumber
datum = date when the error occured
tijd = time when the error occured
username = the nt-username
computername = nt-computername
public_Error_message(loc_str_error_message_text As String) if you call this sub you must give it the the errormessage you got the code looks something like this
errorhandling:
Dim Error_message_text As String
Error_message_text = "form_activate_error"
public_Error_message (Error_message_text)
Resume Next
local_control_for_single_quotes(string) is a function that check tht the string i am trying to save doesnt have any single quotes in them. Because if you have a string with a single quote in it you get an error message because the program then thinks its the end of the string while it still has some text left wich it thinks is now code. Therefor you have add another single quote everytime you come accross one.
networkusername is a function that looks for the username that is used to login into the nt-network
computername is the name of the computer in the network
Public Sub public_Error_message(loc_str_error_message_text As String)
Dim rst_error As New ADODB.Recordset
Dim Con_Main as New ADODB.Connection
Set Con_Main = CurrentProject.Connection
Set rst_error.ActiveConnection = Con_Main
MsgBox "Error in sub " & loc_str_error_message_text & vbCrLf & "Error : " & error & vbCrLf & "Errornumber: " & Err.number, vbOKOnly, "Warning"
rst_error.Open "INSERT INTO [tbl_errorhandling] ([form],[error message text],[error],[errornumber],[datum],[tijd],[username],[computername]) VALUES ('" & Local_Control_For_Single_Quotes(Application.CurrentObjectName) & "' , '" & Local_Control_For_Single_Quotes(loc_str_error_message_text) & "' , '" & Local_Control_For_Single_Quotes(error) & "' , '" & Err.number & "' , '" & Date & "' , '" & Time() & "','" & NetworkUserName & "','" & Computername & "')"
End Sub
too check if you have new errors do this
Set Con_Main = CurrentProject.Connection
Form_Current
If NetworkUserName = "me" Then
errorlable.Visible = True
Dim Rst_Temp As New ADODB.Recordset
Set Rst_Temp.ActiveConnection = Con_Main
Rst_Temp.Open "SELECT COUNT(*) FROM [tbl_errorhandling] WHERE [checked] = 0"
Select Case Rst_Temp.Fields(0)
Case 0
errorlable.Caption = "no errors."
Case 1
errorlable.Caption = "there is " & Rst_Temp.Fields(0) & " error."
errorlable.Caption = errorlable.Caption & vbCrLf & "Klik to view"
Case Else
errorlable.Caption = "There are " & Rst_Temp.Fields(0) & " errors."
errorlable.Caption = errorlable.Caption & vbCrLf & "Click to view"
End Select
Rst_Temp.Close
Else
errorlable.Visible = False
End If
"What a wonderfull world" - Louis armstrong
in my main menu i have a little code witch looks if there are any new errors and tells me how many from wich user and on what computer
there are three functions that come with it namely local_control_for_single_quotes(string),networkusername and computername
First i need a table with these fields
form = string to set the name of the form wich produced the error or report
error message text = string to set the text of the error message
error = string for the shorter errormessage
errornumber = string for the errornumber
datum = date when the error occured
tijd = time when the error occured
username = the nt-username
computername = nt-computername
public_Error_message(loc_str_error_message_text As String) if you call this sub you must give it the the errormessage you got the code looks something like this
errorhandling:
Dim Error_message_text As String
Error_message_text = "form_activate_error"
public_Error_message (Error_message_text)
Resume Next
local_control_for_single_quotes(string) is a function that check tht the string i am trying to save doesnt have any single quotes in them. Because if you have a string with a single quote in it you get an error message because the program then thinks its the end of the string while it still has some text left wich it thinks is now code. Therefor you have add another single quote everytime you come accross one.
networkusername is a function that looks for the username that is used to login into the nt-network
computername is the name of the computer in the network
Public Sub public_Error_message(loc_str_error_message_text As String)
Dim rst_error As New ADODB.Recordset
Dim Con_Main as New ADODB.Connection
Set Con_Main = CurrentProject.Connection
Set rst_error.ActiveConnection = Con_Main
MsgBox "Error in sub " & loc_str_error_message_text & vbCrLf & "Error : " & error & vbCrLf & "Errornumber: " & Err.number, vbOKOnly, "Warning"
rst_error.Open "INSERT INTO [tbl_errorhandling] ([form],[error message text],[error],[errornumber],[datum],[tijd],[username],[computername]) VALUES ('" & Local_Control_For_Single_Quotes(Application.CurrentObjectName) & "' , '" & Local_Control_For_Single_Quotes(loc_str_error_message_text) & "' , '" & Local_Control_For_Single_Quotes(error) & "' , '" & Err.number & "' , '" & Date & "' , '" & Time() & "','" & NetworkUserName & "','" & Computername & "')"
End Sub
too check if you have new errors do this
Set Con_Main = CurrentProject.Connection
Form_Current
If NetworkUserName = "me" Then
errorlable.Visible = True
Dim Rst_Temp As New ADODB.Recordset
Set Rst_Temp.ActiveConnection = Con_Main
Rst_Temp.Open "SELECT COUNT(*) FROM [tbl_errorhandling] WHERE [checked] = 0"
Select Case Rst_Temp.Fields(0)
Case 0
errorlable.Caption = "no errors."
Case 1
errorlable.Caption = "there is " & Rst_Temp.Fields(0) & " error."
errorlable.Caption = errorlable.Caption & vbCrLf & "Klik to view"
Case Else
errorlable.Caption = "There are " & Rst_Temp.Fields(0) & " errors."
errorlable.Caption = errorlable.Caption & vbCrLf & "Click to view"
End Select
Rst_Temp.Close
Else
errorlable.Visible = False
End If
"What a wonderfull world" - Louis armstrong