Private Sub Form_Open(Cancel As Integer)
    
    Me.TimerInterval = 180000

End Sub

Private Sub Form_Timer()
    
Dim varExit As Boolean
Static HinweisIsOpen As Boolean

varExit = Nz(dlookUp("dbExit", "DB_General", True))

If varExit Then
    If HinweisIsOpen Then
        Application.Quit
    Else
        DoCmd.OpenForm "frmExitHinweis" 'окно справки что юзерам либо самим выметаться или их выкинут
        HinweisIsOpen = True
    End If
End If

If Hour(Time) = 23 Then
    Application.Quit
End If

End Sub

Private Sub cmdClose_Click() 'кнопка добровольного закрытия базы
On Error GoTo Err_cmdClose_Click


    DoCmd.Close

Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.Description
    Resume Exit_cmdClose_Click
    
End Sub

Private Sub Form_Open(Cancel As Integer)
    Me.TimerInterval = 12000
    Me.lblClose.Caption = "База будет через 3 минуты закрыта из за Update'a ."
End Sub

Private Sub Form_Timer()
    Static lastTime
    
    If lastTime = 0 Then
        lastTime = 2.8
        Me.lblClose.Caption = "База будет через 3 минуты закрыта из за  Update'a ."
        Exit Sub
    Else
        lastTime = lastTime - 0.2
    End If
    
    Me.lblClose.Caption = "База будет через 3 минуты закрыта из за  Update'a ."
    
    If lastTime <= 0.2 Then
        DoCmd.Close
    End If
End Sub

'*******************************
'  Verlinkung von Tabellen
'*******************************

Function db_linktable()
        
Dim vTbl As String
Dim SQLstr As String
Dim rst As ADODB.RecordSet
Dim strODBCUser As String, strODBCDriver As String, strODBCDBName As String, strODBCDBServer As String

'не забудь создать системную таблицу где будет описано что ты линковать хочешь        
strODBCUser = UserName()
strODBCDriver = dlookUp("DefSource", "DB_Definitions", _
    "DefName = '" & "SQLDatenbank' AND DefSourceName = " & "'Driver" & "'")
strODBCDBName = dlookUp("DefSource", "DB_Definitions", _
    "DefName = '" & "SQLDatenbank' AND DefSourceName = " & "'DBName" & "'")
strODBCDBServer = dlookUp("DefSource", "DB_Definitions", _
    "DefName = '" & "SQLServer' AND DefSourceName = " & "'ServerName" & "'")

SQLstr = "SELECT ALL_TABLES.TableName FROM ALL_TABLES WHERE ALL_TABLES.TableArt = '" & "SQLTable';"
            
Set rst = New ADODB.RecordSet
Set rst = CurrentProject.Connection.Execute(SQLstr)
            
Do While Not rst.EOF
    vTbl = rst("TableName")
        On Error Resume Next
        CurrentDb.TableDefs.Delete vTbl  удаляет линк
        On Error GoTo 0
        CurrentDb.TableDefs.Refresh
    DoEvents
    CreateODBCLinkedTables strODBCDriver, strODBCDBName, strODBCDBServer, CStr(vTbl) ' создает линк
    rst.MoveNext
Loop
     
End Function

'----------------------------------------------------------------------------------
' Verlinkt die Tabellen
'----------------------------------------------------------------------------------
Function CreateODBCLinkedTables(strODBCDriver As String, strODBCDBName As String, _
        strODBCDBServer As String, stbl As String) As Boolean
        
On Error GoTo CreateODBCLinkedTables_Err
Dim accTblName As String, strConn As String
Dim tbl As TableDef

' ---------------------------------------------
' Initialisierung
' ---------------------------------------------
accTblName = stbl
stbl = stbl
' ---------------------------------------------
' Link table
' ---------------------------------------------
  
strConn = "ODBC;"
'strConn = strConn & "DRIVER=SQL Native Client;"
strConn = strConn & "DRIVER=" & strODBCDriver & ";"
strConn = strConn & "SERVER=" & strODBCDBServer & ";"
strConn = strConn & "DATABASE=" & strODBCDBName & ";"
'strConn = strConn & "UID=" & UserName & ";"
strConn = strConn & "Trusted_Connection=Yes;"
strConn = strConn & "TABLE=dbo." & stbl

Set tbl = CurrentDb.CreateTableDef(accTblName, _
dbAttachSavePWD, (stbl), _
strConn)
    
CurrentDb.TableDefs.Append tbl
        
CreateODBCLinkedTables = True
        
CreateODBCLinkedTables_End:
    Exit Function
CreateODBCLinkedTables_Err:
    MsgBox Err.Description, vbCritical, "MyApp"
    Resume CreateODBCLinkedTables_End
        
End Function