Программирование на Visual Basic

06. Файл UDL - это файл строки соединения с базой данных. Эти функции показывают, как можно его создать из VBA

Option Compare Database
Option Explicit
'==============================================================
' ADO. Читаем файл UDL
Private Sub butRead_Click()
    
    ' Строка файла udl
    Dim strUdl As String ' Файл
    strUdl = Application.CurrentProject.Path  "\la_ado.udl"
    
    ' Открываем файл
    Dim fs, f
    Const ForReading = 1
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(strUdl, ForReading, False, -1) ' Читаем файл Unicode
   
    ' Читаем данные из файла
    Dim strCnn As String
    strCnn = f.read(FileLen(strUdl))
    
    ' Закрываем файл
    f.Close
    Set f = Nothing
    Set fs = Nothing
    
    ' Разбор строки для списка
    Dim arCnn ' Массив строк
    arCnn = Split(strCnn, vbCrLf, 5, vbBinaryCompare)
    
    ' Заполнение списка
    Dim i As Long
    Me.myList.RowSource = ""
    For i = 0 To UBound(arCnn) - 1
        Me.myList.RowSource = Me.myList.RowSource  arCnn(i)  ";"
    Next i
End Sub

'==============================================================
' ADO. Создаем файл UDL
Private Sub butWrite_Click()
    ' Строка файла udl
    Dim strUdl As String ' Файл
    strUdl = Application.CurrentProject.Path  "\la_ado1.udl"
    
    ' Открываем файл
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile(strUdl, True, True) ' Файл, Переписать, Unicode
    
    ' Создаем строку для файла
    ' 2 строки информации, 3 для соединения (см. Пример 02)
    '"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Access WebServer\subscribe\_mdb\la_array.mdb;Mode=Read|Write|Share Deny None;Persist Security Info=False;Jet OLEDB:Don't Copy Locale on Compact=True"

    Dim strCnn As String
    strCnn = "[oledb]"  vbCrLf  _
             "; Everything after this line is an OLE DB initstring"  vbCrLf  _
             "Provider=Microsoft.Jet.OLEDB.4.0;Mode=Read|Write|Share Deny None;Persist Security Info=False"  vbCrLf
    f.write strCnn
    
    ' Закрываем файл
    f.Close
    Set f = Nothing
    Set fs = Nothing
    MsgBox "Файл la_ado1.udl создан", vbExclamation, "Лидер Access"
End Sub

04. Открыть таблицы базы данных можно по разному. Эти функции показывают, как можно это сделать из разных библиотек.

'==============================================================
' ADO. Использование таблиц
Private Sub butADO_Click()
Dim rst As ADODB.Recordset
    
    ' Включаем обработку ошибок
    On Error GoTo 999
    
    ' Создание запроса
    Set rst = New ADODB.Recordset
    
    ' Заполняем запрос
    With rst
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "[Пример 04]"
        .Open , CurrentProject.Connection, , , adCmdTable
        If rst.RecordCount Then
            .MoveLast ' Заполнение запроса и расчет кол-ва записей
            .MoveFirst ' Начнем с первой записи
            Do Until .EOF
                ' Изменение записей
                rst!Описание = "ADO. Пример 04"
                rst.Update
                rst.MoveNext
            Loop
        End If
    End With
    
    ' Отображаем список
    Me.myList.RowSource = "ADODB. Изменение сделаны;Всего записей: "  Format(rst.RecordCount, "000")
    
    ' Конец просмотра
    rst.Close
    Set rst = Nothing
    Exit Sub
999:
    MsgBox Err.Description
    Err.Clear
End Sub

'==============================================================
' DAO. Использование таблиц
Private Sub butDAO_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
    
    ' Включаем обработку ошибок
    On Error GoTo 999
    
    ' Создание запроса
    Set dbs = CurrentDb ' Текущая база данных
    Set rst = dbs.OpenRecordset("Пример 04", dbOpenTable)
    
    ' Заполняем запрос
    With rst
        If .RecordCount Then
            .MoveLast ' Заполнение запроса
            .MoveFirst ' Начнем с первой записи
            Do Until .EOF
                ' Изменение записей
                rst.Edit
                rst!Описание = "DAO. Пример 04"
                rst.Update
                rst.MoveNext
            Loop
        End If
    End With
    
    ' Отображаем список
    Me.myList.RowSource = "DAO. Изменения сделаны;Всего записей: "  Format(rst.RecordCount, "000")
    
    ' Конец просмотра
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
    Exit Sub
999:
    MsgBox Err.Description
    Err.Clear
End Sub