Public Function FUN_СREATE_MDB(STR_PATH_BAZA As String, STR_BAZA_NAME As String)
' Создание пустой базы данных
' Объявляем необходимые переменные
Dim AdoxCat As ADOX.Catalog
Dim StrDBPath As String
''Устанавливаем опции
StrDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
Set AdoxCat = New ADOX.Catalog
If FUN_FILE_YES_NO(StrDBPath) = True Then
If FUN_Vopros("Файл " & StrDBPath & vbCrLf & " уже существует..." & vbCrLf & " Заменить его ???", vbQuestion) = False Then
Exit Function
Else
FUN_Delete_File_Name (StrDBPath)
End If
End If
' Создание базы
AdoxCat.Create "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & StrDBPath
Set AdoxCat = Nothing
End Function
Public Function FUN_TRANSFER_TABLE_AND_DATA(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
'Создание Таблицы в базе
Dim AdoxCat_TABLE As Object
Dim AdoxTbl_TABLE As Object
Dim StrDBPath As String
StrDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
Set AdoxCat_TABLE = CreateObject("ADOX.Catalog")
Set AdoxTbl_TABLE = CreateObject("ADOX.Table")
AdoxCat_TABLE.ActiveConnection = "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & StrDBPath
' Проверка наличия таблицы в базе
For Each AdoxTbl_TABLE In AdoxCat_TABLE.Tables
If AdoxTbl_TABLE.Name = STR_TABLE_NAME Then
MsgBox "Таблица " & STR_TABLE_NAME & " уже имеется в базе " & StrDBPath
End If
Next
GLB_con.Execute "SELECT " & STR_TABLE_NAME & ".* INTO " & STR_TABLE_NAME & " IN '" & StrDBPath & "' From " & STR_TABLE_NAME & " WITH OWNERACCESS OPTION"
Set AdoxCat_TABLE = Nothing
Set AdoxTbl_TABLE = Nothing
Set AdoxCat_TABLE = Nothing
End Function
|