Public Function CalcErr(NameMod As String, NameProc As String, NumErr As Long, NameErr As String) As Boolean
  '' Функция, вызываемая при ошибке
  Dim rs As Recordset
  Dim a As String

  '' Узнаем имя этого компьютера
  a = String( 255 , Chr$( 0 ))
  GetComputerName a,  255 
  a = Left(a, InStr( 1 , a, vbNullChar) -  1 )
  
  If NumErr =  3024  Then
   '' Если возникла ошибка при работе со связанной таблицей - переиначиваю связи
    If MsgBox( "Произошла ошибка при работе со связанной таблицей."  & Chr( 10 ) & _
               "Попробовать проверить связанные таблицы?" , vbYesNo) = vbYes Then
      CheckPlaceBases
     '' Предлагаю по завершении обработки повторить/остановить выполнение программы
      CalcErr = (MsgBox( "Обработка связанных таблиц закончена. Повторить операцию?" , vbYesNo) = vbYes)
    End If
  Else
    MsgBox  "Произошла внутренняя ошибка программы № "  & NumErr &  "."  & Chr( 10 ) & Chr( 10 ) & _
           NameErr & Chr( 10 ) & Chr( 10 ) & _
            "Пожалуйста, сообщите разработчику (ЗАО "  "НПФ "  "ИНТАЛ"  ", т. 8 - 264 - 20596 ,  8 - 264 - 75162 )", vbCritical
    CalcErr = False
  Else
    '' Сохраняет имя текущей формы, процедуры, время и пр. мусор в журнале ошибок
    Set rs = CurrentDb.OpenRecordset( "сЖурналОшибок" )
    rs.AddNew
    rs!ErrModule = NameMod
    rs!ErrProc = NameProc
    rs!ErrNumber = NumErr
    rs!ErrMessage = NameErr
    rs!UserNumber = mGlVars.UserNumber
    rs!UserGroup = mGlVars.UserGroup
    rs!ComputerName = a
    rs!ErrTime = Now
    rs.Update
    rs.Close
    Set rs = Nothing
  End If
End Function

Public Function LastDayMonth(DayOfMonth As Date) As Date
On Error GoTo HaveError

  If IsNull(DayOfMonth) Then
    LastDayMonth = Null
  Else
    LastDayMonth = CDate( "01 ." & (CByte(Format(DayOfMonth,  "mm" )) +  1 ) &  "."  & Format(DayOfMonth,  "yyyy" )) -  1 
  End If

EndProc:
Exit Function
HaveError:
мсКонтрОшибок.CalcErr  "мсРазное" ,  "LastDayMonth" , Err.Number, Err.Description
GoTo EndProc
End Function