Программное создание базы данных (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.
Если ссылка установлена, ADOx готов к использованию.
При использовании ADOx все операции так или иначе связаны с объектом Catalog. Этот объект представляет базу данных. Работая в Access, необходимо всего лишь присвоить свойству ActiveConnection объекта Catalog допустимое значение, соответствующее объекту ADO Command, с которого начинается выполнение.
Создание базы данных
Для создания с помощью ADOx новой пустой базы данных необходимо использовать метод Create объекта Catalog, передав ему значение, содержащее путь и имя создаваемой базы данных.

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.