Подключение к excel через udl

[ольгаг]

Здравствуйте Уважаемые программисты!
У меня при запуске книги excel 2003 выполняется следующий код:

Private Sub Workbook_Open()

Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim Filename As Variant
Dim strFileName As String

Filename = "БазаДанных.mdb"
strFileName = Sheets("Начало").DirBD

If Dir(strFileName & Filename) <> "" Then
Set dbs = DAO.OpenDatabase(strFileName & Filename, True, True, ";pwd=база")
End If

Set rs = dbs.OpenRecordset("SELECT * FROM ТАБЛИЦА1")

Sheets("Таблица1").Columns("A:A").C learContents
i = 1
Do While Not rs.EOF
Sheets("Таблица1").Cells(i, 1).Value = rs.Fields("Элемент")
i = i + 1
rs.MoveNext
Loop

rs.Close
dbs.Close
Set rs = Nothing
Set dbs = Nothing

End Sub

который загружает из файла базы Access из таблицы1 данные на лист excel с именем Таблица1.

Подскажите пожалуйста, как мне изменить приведенный выше код, чтобы данные грузились способом подключения udl-файла (в этом файле путь к базе Access и пароль заданы, проверка подключения работает)? Так, например, я нашла следующие строки ниже, но не знаю как дальше.

Dim cn
Set cn = CreateObject("ADODB.Connection")
cn.Provider = "MSDASQL.1"
cn.ConnectionString = "File Name = C:\Connect.udl"
cn.Open

Заранее спасибо.

[AndVGri]

Можно же и без udl или, впрочем, вариант для аналогии

Public Sub CreateQueryTable()
    Dim sSQL As String, sConn As String
    Dim pSheet As Excel.Worksheet
    Dim pQTable As Excel.QueryTable
    
    sConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Mode=Read;Data Source=d:\path\database.mdb;User ID=admin;Password="
    sSQL = "Select * From Таблица1"
    Set pSheet = ThisWorkbook.Worksheets.Add
    Set pQTable = pSheet.QueryTables.Add(sConn, pSheet.Cells(1, 1), sSQL)

    pQTable.Refresh
End Sub

[ольгаг]

У меня получился такой код:

Private Sub Workbook_Open()

Dim cn As ADODB.Connection
Set cn = CreateObject("ADODB.Connection")

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.ConnectionString = "File Name = C:\Connect.udl"
cn.Open

Dim rs As ADODB.Recordset
Dim i As Integer

Set rs = CreateObject("ADODB.Recordset")
Set rs = cn.Execute("SELECT * FROM Таблица1")

Sheets("Таблица1").Columns("A:A").C learContents
i = 1
Do While Not rs.EOF
Sheets("Таблица1").Cells(i, 1).Value = rs.Fields("Элемент")
i = i + 1
rs.MoveNext
Loop

cn.Close
rs.Close
Set cn = Nothing
Set rs = Nothing

End Sub

Но при запуске книги появляется сообщение: "Невозможно найти устанавливаемый ISAM". Библиотеку ADO подключила, файл udl проверку выполняет успешно.
Подскажите пожалуйста, может у меня ошибка в выборе драйвера?
Если открыть файл udl блокнотом, то там следующая запись:
[oledb]
; Everything after this line is an OLE DB initstring
Provider=MSDASQL.1;Password=...;Per sist Security Info=True;User ID=...;Data Source=База данных MS Access;Initial Catalog=C:\БазаДанных.mdb
Спасибо.

[DiemonStar]

Dim rs As ADODB.Recordset

и

Set rs = CreateObject("ADODB.Recordset")

вроде же по сути дублирование кода, разве что в первом случае нужно так:

Dim rs As New ADODB.Recordset

только в первом случае, необходима ссылка в Referencies, а во втором - она не требуется.

[AndVGri]

ольгаг
Сударыня, что же вы так упорны?
Чем не устроил мой код? Данные будут обновляться в таблице по нажатию кнопки "Обновить".
Если же вам нужно только однократное чтение (как приведено в вашем коде), то нужно считать строку подключения

Provider=MSDASQL.1;Password=...;Per sist Security Info=True;User ID=...;Data Source=База данных MS Access;Initial Catalog=C:\БазаДанных.mdb

из udl как из текстового файла, допустим в переменную strConn и загрузить данные следующим кодом (учитывая, что вы используете раннее связывание)

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

cn.Open strConn
rs.Open "SELECT Элемент FROM Таблица1", cn
Sheets("Таблица1").Columns("A:A").ClearContents
Sheets("Таблица1").Cells(1, 1).CopyFromRecordset rs
rs.Close: cn.Close

[ольгаг]

Спасибо всем большое!
У меня заработал следующий код:

Private Sub Workbook_Open()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
On Error GoTo Proc_Err
Set conn = New ADODB.Connection
conn.Open "File Name=c:\Data Links\connect.udl;"
Set rst = New ADODB.Recordset
rst.Open "Select * From Таблица1", conn
Dim i As Integer
Sheets("Таблица1").Columns("A:A").C learContents
i = 1
Do While Not rst.EOF
Sheets("Таблица1").Cells(i, 1).Value = rst.Fields("Элемент")
i = i + 1
rst.MoveNext
Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
Proc_Exit:
Exit Sub
Proc_Err:
MsgBox Err.Description
Resume Proc_Exit
End Sub

Меня устраивает этот код, т.к. я думаю в дальнейшем попробовать положить файл базы mdb и файл udl на сервер, например, в скрытую папку (чтобы защитить ее от всех пользователей).
Подскажите пожалуйста, как в данный код можно прописать, например, чтобы при открытии книги excel был выбор конкретных пользователей с паролем и в случае не соответствия книга бы сворачивалась. Может это можно как-то прописать в udl-файле?
Спасибо.

[Virtuallab]

По последнему вопросу, если по пользователям и правам реализовывать макросом, то The_Prist, в соседней теме давал ссылку:
http://www.excel-vba.ru/chto-umeet-e...-listdiapazon/


По передаче данных из базы в Excel, что бы не тянуть в цикле до конца рекордсета, можно посмотреть вариант (MS Office 2003):
Данные->Импорт внешних данных->импортировать данные...
Кнопка "Создать"
Выбрать из списка "ODBC DSN"->"База данных MS Access"
Указать базу.
В диалоговом окне можно сконструировать запрос.
В скрытой папке "Мои документы\Мои источники данных" будет сохранен файл с расширением "odc".

Кроме того можно поэкспериментировать с SQL, что бы данные быстрее перебрасывались.

[ольгаг]

Уважаемые программисты, подскажите пожалуйста как можно исправить код ниже, с учетом использования ADO (через ADODB.Connection). Дело в том, что у меня не получается правильно записать код для загрузки данных из таблиц базы access (т.е. сейчас с помощью DAO работает - если в excel есть лист с именем таблицы из базы access, то данные в него заносятся, а если листа нет, то он создается с именем таблицы access и далее данные также заносятся):

Private Sub Workbook_Open()

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.Open "File Name=c:\connect.udl;"

Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim tdf As DAO.TableDef
Dim wkbk As Excel.Workbook
Dim Sheet As Worksheet
Dim wksht As String
Dim i As Integer
Dim xl As New Excel.Application
Dim strTables As String

xl.DisplayAlerts = False
With wkbk
For Each tdf In dbs.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then
Set rs = dbs.OpenRecordset(tdf.Name, dbOpenDynaset)
wksht = tdf.Name
On Error Resume Next
Set Sheet = Sheets(wksht)
If Err Then
Err.Clear
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
i = 1
Do While Not rs.EOF
Sheets(wksht).Cells(i, 1).Value = rs.Fields("Элемент")
i = i + 1
rs.MoveNext
Loop
Else
Sheets(wksht).Columns("A:A").ClearC ontents
i = 1
Do While Not rs.EOF
Sheets(wksht).Cells(i, 1).Value = rs.Fields("Элемент")
i = i + 1
rs.MoveNext
Loop
End If
End If
Next tdf
End With
xl.DisplayAlerts = True
End Sub

Может быть нужно использовать библиотеку ADOx и элемент catalog?
Заранее спасибо.