Подключение таблиц 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