Подключение базы Access к SQL Server

Private Sub TableConnect()
Dim sTableNameLocal As String
Dim sTableNameSRS As String
Dim sServerName As String
Dim sDBName As String
Dim userName As String
Dim userPW As String
Dim x As Long
 
'Задаём параметры подключения
'es - 25.12.2012
'--------------------------------------------------------------------
On Error GoTo TableConnect_Err
    sServerName = "192.168.0.1\SQLExpress"      ' IP и Имя сервера
'Или:
'   sServerName = "192.168.0.1\MSSQLSERVER"     ' IP и Имя сервера
    sDBName = "DB_Name"                         ' Имя базы данных
    
    userName = "DBUserName"                     ' Имя пользователя
    userPW = "12345678"                         ' Пароль
        
    sTableNameLocal = "Loc_TableName"           ' Локальное имя Таблицы  в тек БД
    sTableNameSRS = "Srs_TableName"             ' Имя Таблицы на Сервере (Исходное)
        
        
'Подключаем таблицу:
    x = esLinkTableADOX(sTableNameLocal, sTableNameSRS, sServerName, sDBName, userName, userPW)
    'тест
    If x > 0 Then MsgBox "Таблица: " & sTableNameSRS & " не подключена !!!!", vbCritical, "Ошибка подключения"
 
'Обновляем список таблиц
    CurrentDb.TableDefs.Refresh
    DoEvents
 
TableConnect_Bye:
    Exit Sub
 
TableConnect_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure TableConnect", vbCritical, "Error!"
    Resume TableConnect_Bye
End Sub

Public Function esLinkTableADOX(sLocalTName As String, stRemTName As String, sServName As String, _
        sDbName As String, Optional sUserName As String, Optional sPassWord As String) As Long
 
'es 30.06.2011
'Подключение к таблице SQL Server с автоматическим созданием DSN (ADOX)
'При удачном подключениии возвращает = 0 (ноль), при неудачном = КОД ОШИБКИ (номер)
'-------------------------------------------------------------------------
'Требования:
'   Сссылка в References на "Microsoft ADO Ext. x.x for DDL and Security" (v 2.8 = работало)
'-------------------------------------------------------------------------
'Аргументы:
'   sLocalTName = Локальное Имя Таблицы
'   stRemTName  = Имя таблицы на сервере
'   sServName   = Имя сервера MS SQL
'   sDbName     = Имя базы данных SQL Server
'   sUserName   = Имя пользователя (Опционально)
'   sPassWord   = Пароль пользователя (Опционально)
'-------------------------------------------------------------------------
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim strConnect As String
    
'Формируем строку подключения
    If Len(sUserName) = 0 Then
        ' Если sUserName не указано, использовать доверенную проверку подлинности.
        strConnect = "ODBC;DRIVER=SQL Server;SERVER=" & sServName & ";DATABASE=" & sDbName & ";Trusted_Connection=Yes"
    Else
        '!!! ПРЕДУПРЕЖДЕНИЕ: Вместе с информацией о связанной таблице сохраняется имя пользователя и его пароль.
        strConnect = "ODBC;DRIVER=SQL Server;SERVER=" & sServName & ";DATABASE=" & sDbName & ";UID=" & sUserName & ";PWD=" & sPassWord
    End If
    
'Открываем каталог текущей базы
    Set cat.ActiveConnection = CurrentProject.Connection
    
'Если таблица с таким названием уже существует - Удаляем
    For Each tbl In cat.Tables
        If tbl.Name = sLocalTName Then cat.Tables.Delete tbl.Name
    Next
 
'Для наглядности
'    Debug.Print "Без таблицы " & sLocalTName & " - таблиц в базе = " & cat.Tables.Count
    
'Установка параметров таблицы
    With tbl
        .Name = sLocalTName
        Set .ParentCatalog = cat
        .Properties("Jet OLEDB:Link Provider String") = strConnect
        .Properties("Jet OLEDB:Remote Table Name") = stRemTName
        .Properties("Jet OLEDB:Create Link") = True
    End With
    
'Создаём новый обьект
    cat.Tables.Append tbl
 
'Обновляем список таблиц
    cat.Tables.Refresh
    DoEvents
 
'Для наглядности
'    Debug.Print "После создания таблицы " & sLocalTName & " - таблиц в базе = " & cat.Tables.Count
 
esLinkTableADOXBye:
    Set cat = Nothing
    Set tbl = Nothing
    Exit Function
 
esLinkTableADOXErr:
    esLinkTableADOX = Err.Number
    Debug.Print "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
            "in Function: esLinkTableADOX"
    Resume esLinkTableADOXBye
End Function

  sServerName = "192.168.0.1\SQLExpress"      ' IP и Имя сервера
'Или:
'   sServerName = "192.168.0.1\MSSQLSERVER"     ' IP и Имя сервера
    sDBName = "DB_Name"                         ' Имя базы данных

Public Sub ADOTest()
   Dim ADOConn As New ADODB.Connection
   Dim ADORec As New ADODB.Recordset
   
'   On Error Resume Next
   ADOConn.ConnectionString = "Driver={SQL Server};Server=ServerName;Database=master;Uid=Log;Pwd=pass;"
   ADOConn.Open
   
   Do While ADOConn.State <> 1
       DoEvents
       If ADOConn.State = 0 Then Exit Sub
   Loop
  
  Set ADORec.ActiveConnection = ADOConn
  ADORec.LockType = adLockOptimistic
  ADORec.Source = "SELECT * FROM Table_Name"
  ADORec.Open
  
  If Not ADORec.EOF Then ADORec.MoveFirst
  Do Until ADORec.EOF
       Debug.Print ADORec("BAR_CODE")
       ADORec.MoveNext
  Loop
  ADORec.Close
End Sub

Private Sub runQuery()
   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Dim conn As String
   
   conn = "Driver={SQL Server Native Client 11.0};Server=ServerName;Database=master;Uid=Log;Pwd=pass;"
   
   Set db = OpenDatabase("", False, False, conn)
   Set rs = db.OpenRecordset("Table_Name", dbOpenDynaset, dbSeeChanges)
   
   If Not rs.EOF Then rs.MoveFirst
   Do Until rs.EOF
     Debug.Print rs!BAR_CODE
     
     rs.MoveNext
   Loop
   
End Sub

Private Sub fillSubForm()
 Dim SQL As String
 Dim db As DAO.Database
 Dim rs As DAO.Recordset
 
 Set db = OpenDatabase("", False, False, "Driver={SQL Server};Server=Имя Сервера;Database=master;Uid=Логин;Pwd=Пароль;")
 
 
 SQL = "SELECT Таблица.CODE, Таблица.Articl, Таблица.CAPTION, Таблица.FACING, Таблица.PRICE, Таблица.STATUS " _
       & "FROM Таблица;"
       
 Set rs = db.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly)
 Set Me.Form.Recordset = rs
 Me.Form.Recordset.Requery
End Sub