Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim StrFileDB As String
Dim ADOF As New ADOX.Catalog
Dim NameTable As String
StrFileDB = ""
SaveFileDialog1.Filter = "Access file (*.mdb) | *.mdb"
SaveFileDialog1.ShowDialog()
If SaveFileDialog1.FileName <> "" Then
StrFileDB = SaveFileDialog1.FileName
End If
If StrFileDB <> "" Then
FileNameDB.Text = StrFileDB
NameTable = "tblSQLQuery"
'Закроем что есть
'Call CloseDataBase() вот это не понятно
'создаем базу данных
ADOF.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & StrFileDB)
'создадим таблицу и поля с помощью ADOX
Dim oTable As New ADOX.Table
'Создаем поле со счетчиком (Autoincrement ID Column)
Dim oColumn As New ADOX.Column
With oTable
.Name = NameTable
With .Columns
.Append("id", ADOX.DataTypeEnum.adInteger)
With !id
.ParentCatalog = ADOF
.Properties("Autoincrement").Value = True
.Properties("seed").Value = ADOX.DataTypeEnum.adInteger
.Properties("increment").Value = ADOX.DataTypeEnum.adInteger
End With
End With
End With
ADOF.Tables.Append(oTable)
'Создаем ключ
Dim keysPrimary As New ADOX.Key
keysPrimary.Name = "PrimaryKey"
keysPrimary.Type = ADOX.KeyTypeEnum.adKeyPrimary
keysPrimary.Columns.Append("id")
oTable.Keys.Append(keysPrimary, ADOX.KeyTypeEnum.adKeyPrimary)
'Добавляем поля с помощью ADOX
Try
Dim Name As New ADOX.Column
Name.Name = "name"
Name.Type = ADOX.DataTypeEnum.adVarWChar 'текст
Name.DefinedSize = 50 'длина 50
Name.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(Name)
Dim query As New ADOX.Column
query.Name = "query"
query.Type = ADOX.DataTypeEnum.adLongVarWChar 'текст
query.DefinedSize = 0 'длина до 65535
query.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(query)
Dim strserver As New ADOX.Column
strserver.Name = "strserver"
strserver.Type = ADOX.DataTypeEnum.adVarWChar 'текст
strserver.DefinedSize = 50 'длина 50
strserver.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(strserver)
Dim strdatabase As New ADOX.Column
strdatabase.Name = "strdatabase"
strdatabase.Type = ADOX.DataTypeEnum.adVarWChar 'текст
strdatabase.DefinedSize = 50 'длина 50
strdatabase.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(strdatabase)
Dim strconnection As New ADOX.Column
strconnection.Name = "strconnection"
strconnection.Type = ADOX.DataTypeEnum.adLongVarWChar 'текст
strconnection.DefinedSize = 0 'длина до 65535
strconnection.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(strconnection)
Dim strtime As New ADOX.Column
strtime.Name = "strtime"
strtime.Type = ADOX.DataTypeEnum.adVarWChar 'текст
strtime.DefinedSize = 50 'длина 50
strtime.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(strtime)
Dim StrLogin As New ADOX.Column
StrLogin.Name = "StrLogin"
StrLogin.Type = ADOX.DataTypeEnum.adVarWChar 'текст
StrLogin.DefinedSize = 50 'длина 50
StrLogin.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(StrLogin)
Dim StrPWD As New ADOX.Column
StrPWD.Name = "StrPWD"
StrPWD.Type = ADOX.DataTypeEnum.adVarWChar 'текст
StrPWD.DefinedSize = 50 'длина 50
StrPWD.Attributes = ADOX.ColumnAttributesEnum.adColNullable 'необязательное поле
oTable.Columns.Append(StrPWD)
oTable.Columns.Append("TypeQuery", ADOX.DataTypeEnum.adUnsignedTinyInt)
'Закрываем все
ADOF = Nothing
keysPrimary = Nothing
'Откроем все по новой
'OpenDataBase() вот это не понятно
MsgBox("База данных создана")
Catch ex As Exception
MsgBox("Ошибка при создании базы данных " & ex.Message)
End Try
End If
End Sub
End Class
|