|
|||||||
Подключение таблиц SQL Server без DSN (ADOX)
Время создания: 16.03.2019 23:43
Раздел: Разные закладки - VBA - Access - msa.polarcom.ru - 02 Внешние Данные
Запись: xintrea/mytetra_db_adgaver_new/master/base/1531933966pz1fy1m45q/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
Подключение таблиц SQL Server без DSN (ADOX) Внимание! 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!!! |
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|