تعديل كود

[jamal2080]

Public Sub Handle_Errors_ADO(strFile As String, lngError As Long, InError As String)

'If lngError = 2046 Or lngError = 2110 Or lngError = 2499 Then
 
 If lngError = 2110 Or lngError = 20 Or lngError = -2147352567 _
    Or lngError = 2455 Or lngError = 2424 Or lngError = 3167 _
    Or lngError = 3021 Or lngError = 2499 Or lngError = 2427 Then

            GoTo Exit_Error_BT_Click
   Else
   

    Dim StrError As String
    Dim strSQL As String

   
    Dim rst As New ADODB.Recordset
   
On Error GoTo Err_Error_BT_Click

    strSQL = "SELECT ErrMsg FROM ErrMessage where errcode=" & CStr(lngError)
    

    rst.Open strSQL, CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic

    
    rst.MoveFirst
    StrError = rst.Fields(0)
    rst.Close
    
    ' ******************************************************
    
' StrError = " ÊäÈíÉ:     " & CStr(lngError) & " - " & StrError
    StrError = StrError
    
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    
    If strFile = "" Then
       Msg = StrError
    Else
       Msg = StrError & " - " & strFile
    End If
    

    Style = vbOKOnly
    Title = "          ãäÙæãÉ ÇáÇÓÊáÇã ÇáãæÇÏ ÇáãÍáíÉ"    ' Define title.
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    
  
  
  
  End If
  
    
Exit_Error_BT_Click:
    Exit Sub

Err_Error_BT_Click:
  MsgBox Err.DESCRIPTION
    Resume Exit_Error_BT_Click
        
    
    
End Sub

 

عندى اضافة سجل جديد يظهر errer فى سطر   

Dim rst As New ADODB.Recordset

[د.كاف يار]

للاتصال بنفس القاعدة استبدل سطر الخطاء الى

Dim rst As New ADO.Recordset