|
|||||||
Время создания: 16.03.2019 23:43
Текстовые метки: VBA, CreateDataBase, создание базы данных
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 01 Базы Данных
Запись: xintrea/mytetra_db_adgaver_new/master/base/15319712119f3xul9z7f/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
Программное создание базы данных (ADO) '================================================================================================== '##### Создаем новую базу ADO: http://msa.polarcom.ru/st/s0000353.htm Private Sub test_funCreateDataBaseADO() blnfunCreateDataBaseADO = funCreateDataBaseADO(True, ThisWorkbook.Path & "\" & "NewDB.accdb") '"NewDB.mdb" End Sub '-------------------------------------------------------------------------------------------------- Function funCreateDataBaseADO(ByVal blnReCreate As Boolean, _ ByVal newDB As String) As Boolean 'Данная процедура создает новую базу данных с использованием возможностей ADOx. 'необходимо установить ссылку на библиотеку Microsoft ADO Ext. 2.1 For DDL and Security Dim cat As ADOX.Catalog Dim m As Variant, strExt As String, strError As String Err.Clear On Error GoTo Proc_Err 'считываем расширение файла '---------------------------------- If Len(newDB) > 0 Then m = Split(newDB, ".", -1, vbTextCompare) strExt = m(UBound(m)) Erase m Else 'выход если файл не задан strError = "#=================================================" & vbCrLf & _ " " & "funCreateDataBaseADO" & "-" & vbCrLf & _ "Не удалость считать расширение файла" & vbCrLf & "( " & newDB & " )" & vbCrLf & _ "#-------------------------------------------------" & vbCrLf Resume Proc_Err End If 'определяем строку подключения в соответствии с форматом создаваемого файла '---------------------------------- Select Case strExt Case "mdb": strProvider = "provider=Microsoft.JET.OLEDB.4.0;data source=" Case "accdb": strProvider = "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" Case Else End Select
'Объект Catalog в ADOx '----------------------------------
If Dir(newDB) <> "" Then 'Проверка на существование файла If blnReCreate Then 'Если задано пересоздание Kill newDB 'Уничтожаем старую базу данных Else funCreateDataBaseADO = True GoTo Proc_Exit 'Выход End If End If Set cat = New ADOX.Catalog cat.Create (strProvider & newDB) 'Создаем базу Set cat = Nothing '---------------------------------- Proc_Exit: Exit Function Proc_Err: If Len(strError) = 0 Then Debug.Print "#=================================================" & vbCrLf & _ " " & "funCreateDataBaseADO" & "-" & vbCrLf & _ Err.Description & vbCrLf & "(" & newDB & ")" & vbCrLf & _ "#-------------------------------------------------" Else Debug.Print strError ': MsgBox strError End If Resume Proc_Exit End Function '---------------------------------- '================================================================================================== Прислал: Сонных Дмитрий (aka Joss) sonni-dim@mail.ru С помощью ADO можно легко изменять структуру данных. Для создания и изменения таблиц, запросов и других объектов данных, например индексов, следует использовать специальную библиотеку ADO, называемую ADOx. Перед использованием ADOx необходимо установить ссылку на библиотеку Microsoft ADO Ext. 2.1 For DDL and Security, выполнив команды меню Tools | References (Сервис | Ссылки) в VBE. Sub CreateDataBaseADO(newDB As String) 'Данная процедура создает новую базу данных с использованием возможностей ADOx. 'По материалам книги "Microsoft Access 2000 Development Unleashed" издательства SAMS 'Авторы: Forte, Howe, Ralston 'Объект Catalog в ADOx Dim cat As ADOx.Catalog On Error GoTo Proc_Err Set cat = New ADOx. Catalog cat.Create "provider=Microsoft.JET.OLEDB.4.0;data source=" & newDB MsgBox "Database Created!", vbInformation Proc_Exit: Exit Sub Proc_Err: MsgBox Err.Description Resume Proc_Exit End Sub Перед использованием ADOx необходимо установить ссылку на библиотеку Microsoft ADO Ext. 2.X For DDL and Security, выполнив команды меню Tools -> References (Сервис -> Ссылки) в VBE. |
|||||||
Так же в этом разделе:
|
|||||||
![]() |
|||||||
|
|||||||
|