Sub link_sql()
Dim rs
Set rs = New ADODB.Recordset
rs.Open "select * from _linktables", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do Until rs.EOF
        SilentDropTable (rs!tablename)
        DoEvents

  DoCmd.TransferDatabase _
  acLink, _
  "ODBC Database", _
  "ODBC;Driver={SQL Server};Server=dataserver\dataserver2000;Database=Buch2;Trusted_Connection=Yes", _
  acTable, "dbo." & rs!tablename & "", rs!tablename
    
  rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub

Public Sub SilentDropTable(tablename)
On Error Resume Next
CurrentDb.Execute "drop table " & tablename 'table
End Sub

<button id="button112"
   label="Приходный кассовый ордер(ПКО)"  
   imageMso="AdpOutputOperationsAddToOutput" 
   enabled="true" 
   onAction="=Reload_form('00_PKO')"  />

Public Function Reload_form(FRM_NAME As String, Optional WM As AcWindowMode = acWindowNormal, Optional openarg As String)
    On Error Resume Next
    SysCmd acSysCmdSetStatus, FRM_NAME
    If CurrentProject.AllForms(FRM_NAME).IsLoaded Then DoCmd.Close acForm, FRM_NAME
    DoCmd.OpenForm FRM_NAME, , , , , WM, openarg
End Function

Sub tstremovemacro()
Dim macrotext, arg
Dim mm
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select * from USysRibbons", CurrentProject.Connection, adOpenKeyset, adLockOptimistic


For Each mm In CurrentProject.AllMacros
    macrotext = getmacro_text(mm.NAME, "Action =""OpenForm""")
    If macrotext <> "" Then
        arg = Split(Split(macrotext, "Argument =""")(1), Chr(34))(0)
        rs!ribbonxml = Replace(rs!ribbonxml, mm.NAME, "=Reload_form('" & arg & "')")
        'DoCmd.DeleteObject acMacro, mm.NAME
        Debug.Print arg & vbCrLf
    End If
Next mm

rs.Update
rs.Close
End Sub

 Function getmacro_text(strMacroName As String, strQueryName As String) As String
    Dim oFSO 'As New FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim oFS
    Dim strFileContents As String

        Application.SaveAsText acMacro, strMacroName, "c:\temp.txt"
        Set oFS = oFSO.OpenTextFile("c:\temp.txt")
        strFileContents = ""
        Do Until oFS.AtEndOfStream
            strFileContents = strFileContents & oFS.ReadLine
        Loop
        Set oFS = Nothing

        Kill "c:\temp.txt"
    
        If InStr(strFileContents, strQueryName) <> 0 Then
          getmacro_text = strFileContents
        End If
    
    Set oFSO = Nothing
 End Function

SQLADOEXECUTE ("exec [98_Dog_autoregistration]")

Public Const ADOCONSTRING = "Driver={SQL Server};Server=dataserver\dataserver2000;Database=Buch2;Trusted_Connection=Yes"

Public Function SQLADOEXECUTE(sql) As ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
    cnn.Open ADOCONSTRING
    Set SQLADOEXECUTE = cnn.Execute(sql)
    cnn.Close
    Set cnn = Nothing
End Function

CREATE procedure [dbo].[98_Dog_autoregistration]
as
insert [dbo].[98_Dog] ( PROD_CODE , MANAGER )
SELECT rtrim(ltrim([code])), manager
 FROM dbo.PRODCODE  
where year(cast ([DATE_DOG] as datetime )) >= 2012 
and Left([code],2)='00'
and rtrim(ltrim([code])) not in ( select [PROD_CODE] FROM [buch2].[dbo].[98_Dog])


update d set manager = prod.manager
--select  d.manager , prod.manager
from [dbo].[98_Dog] d 
inner join dbo.PRODCODE prod on rtrim(ltrim(prod.[code])) = [PROD_CODE]
where d.manager <> prod.manager

return 0