TopPicLogo TopPicText

Подключение таблиц SQL Server без DSN (ADOX)

Внимание!
Требуется ссылка на библиотеку: Microsoft ADO Ext. x.x for DDL and Security

Пример Использования:

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

Achtung!!!
Требуется ссылка на библиотеку: Microsoft ADO Ext. x.x for DDL and Security

Назад ToTop
L.E. 29.12.2012
Рейтинг@Mail.ru