Помогите пожалуйста создать базу Access кодом

[VisMajor]

Помогите пожалуйста создать базу Access кодом, или при помощи Access только что бы он не отображался на рабочем столе и не выдавал сообщений об ошибках.

Заранее благодарен. Юрий.

[boevik]

При использовании DAО:

Код: Выделить всё

CreateDatabase "c:\db1.mdb", dbLangGeneral


[VisMajor]

При использовании DAО:

Код: Выделить всё

CreateDatabase "c:\db1.mdb", dbLangGeneral


А как табличку с полями - счетчик, дата, текстовое?

Заранее благодарен, Юрий.

[alibek]

Создать модуль modDatabase.bas и скопировать текст в него

Код: Выделить всё

Option Explicit

Global db As DAO.Database

Private Const dbFileName As String = "database.mdb"
Private Const dbPassword As String = "password"

Public Enum ResultCodes
  rcUnknown = 0
  rcOK = 1
  rcCancel = 2
  rcError = 3
End Enum

Public Function InitDB() As ResultCodes
Dim F As String, res As ResultCodes
F = AppPath & dbFileName
If Len(Dir$(F)) = 0 Then
  If MsgBox("Не обнаружена база данных! Создать новую базу данных?", vbQuestion + vbYesNo) = vbYes Then
    On Error Resume Next
      Set db = DAO.CreateDatabase(F, dbLangCyrillic & ";pwd=" & dbPassword, dbVersion30)
      res = IIf(Err = 0, rcOK, rcError)
      db.Close
    On Error GoTo 0
    If res <> rcOK Then MsgBox "Не удается создать базу данных!", vbExclamation
  Else
    res = rcCancel
  End If
  If res <> rcOK Then InitDB = res: Exit Function
End If
InitDB = rcOK
Set db = DAO.OpenDatabase(F, False, False, dbLangCyrillic & ";pwd=" & dbPassword)
InitTables "SampleTable"
End Function

Public Function InitTables(ByVal TableName As String) As ResultCodes
Dim td As TableDef, I As Long
For I = 0 To db.TableDefs.Count - 1
  If db.TableDefs(I).Name = TableName Then Exit For
Next I
If I < db.TableDefs.Count Then Exit Function
Select Case TableName
  Case "SampleTable"
    Set td = CreateTableDef(TableName, Array("*|ID|ID", "U|Order|No", "U|FullName|No;Name", "RevName|-Name"), _
    "ID|+", "R|No|Long", "RZ|Name|Text*100", "RZ|Text|Memo")
  Case Else
    Exit Function
End Select
db.TableDefs.Append td
Set td = Nothing
End Function

Private Sub InitTable_Prepare(NumField As Integer, NumIndex As Integer, Fields() As Field, Indexes() As Index)
Dim I As Integer
ReDim Fields(0), Indexes(0)
If NumField > 0 Then ReDim Fields(1 To NumField)
If NumIndex > 0 Then ReDim Indexes(1 To NumIndex)
For I = 1 To NumField
  Set Fields(I) = New Field
Next I
For I = 1 To NumIndex
  Set Indexes(I) = New Index
Next I
End Sub

Private Function CreateTableDef(Name As String, Indexes As Variant, ParamArray Fields() As Variant) As TableDef
'Indexes - string or string array
'  Item: [[*][U][N]|]Name|[+|-]field ¹...
'    * - Primary
'    U - Unique (default for primary)
'    N - Ignore nulls
'    Field ¹ - field(s) numbers
'Fields: [[R][Z]|]Name|Type[*Size]
'  R - Required field (default)
'  Z - Allow zero length
'  Name - Field name
'  Type - Field type
'    +     - Long Auto Increment (counter)
'    BigInt- BigInt
'    Bin   - Binary
'    Bool  - Boolean
'    Byte  - Byte
'    Char  - Char
'    Cur   - Currency
'    Date  - Date
'    Dec   - Decimal
'    Dbl   - Double
'    Float - Float
'    GUID  - GUID
'    Int   - Integer
'    Long  - Long
'    LBin  - LongBinary
'    Memo  - Memo
'    Num   - Numeric
'    Sng   - Single
'    Text  - Text
'    Time  - Time
'  Size - Field size (in bytes for Text and Char)
Dim td As TableDef, fld() As Field, idx() As Index
Dim NF As Long, NI As Long, C As Long, N As Long, I As Long, Z As String
Dim S0 As String, S1 As String, S2 As String
For I = LBound(Fields) To UBound(Fields)
  If VarType(Fields(I)) = vbString Then NF = NF + 1
Next I
If VarType(Indexes) >= vbArray Then
  For I = LBound(Indexes) To UBound(Indexes)
    If VarType(Indexes(I)) = vbString Then NI = NI + 1
  Next I
ElseIf VarType(Indexes) = vbString Then
  Z = Indexes
  ReDim Indexes(0)
  Indexes(0) = Z
  If Len(Z) > 0 Then NI = 1
End If
InitTable_Prepare (NF), (NI), fld(), idx()
NF = 0
For C = LBound(Fields) To UBound(Fields)
  If VarType(Fields(C)) = vbString Then Z = Fields(C) Else Z = ""
  If Len(Z) > 0 Then
    NF = NF + 1
    If InStr(Z, "|") = 0 Then
      S0 = Z
      S1 = "+"
      S2 = "R"
    Else
      I = InStrRev(Z, "|")
      S1 = Mid$(Z, I + 1)
      Z = Left$(Z, I - 1)
      If InStr(Z, "|") = 0 Then
        S0 = Z
        S2 = "R"
      Else
        I = InStrRev(Z, "|")
        S0 = Mid$(Z, I + 1)
        S2 = Left$(Z, I - 1)
      End If
    End If
    S1 = UCase$(S1): S2 = UCase$(S2)
    fld(NF).Name = S0
    If InStr(S1, "-") > 0 Then
      Mid$(S1, InStr(S1, "-"), 1) = "*"
      fld(NF).Attributes = fld(NF).Attributes + dbFixedField
    End If
    If InStr(S1, "*") > 0 Then
      I = Val(Mid$(S1, InStr(S1, "*") + 1))
      Z = UCase$(Left$(S1, InStr(S1, "*") - 1))
    Else
      I = 0
      Z = S1
    End If
    Select Case Z
      Case "+"
        fld(NF).Type = dbLong
        fld(NF).Attributes = fld(NF).Attributes + dbAutoIncrField
      Case "BIGINT", "BIG INT"
        fld(NF).Type = dbBigInt
      Case "BIN", "BINARY"
        fld(NF).Type = dbBinary
      Case "BOOL", "BOOLEAN"
        fld(NF).Type = dbBoolean
      Case "BYTE"
        fld(NF).Type = dbByte
      Case "CHAR", "CHAR"
        fld(NF).Type = dbChar
      Case "CUR", "CURRENCY"
        fld(NF).Type = dbCurrency
      Case "DATE", "DATE"
        fld(NF).Type = dbDate
      Case "DEC", "DECIMAL"
        fld(NF).Type = dbDecimal
      Case "DBL", "DOUBLE"
        fld(NF).Type = dbDouble
      Case "FLOAT"
        fld(NF).Type = dbFloat
      Case "GUID"
        fld(NF).Type = dbGUID
      Case "INT", "INTEGER"
        fld(NF).Type = dbInteger
      Case "LONG", "LONG"
        fld(NF).Type = dbLong
      Case "LBIN", "LONGBINARY", "LONG BINARY"
        fld(NF).Type = dbLongBinary
      Case "MEMO"
        fld(NF).Type = dbMemo
      Case "NUM", "NUMERIC"
        fld(NF).Type = dbNumeric
      Case "SNG", "SINGLE"
        fld(NF).Type = dbSingle
      Case "TEXT", "TXT", "STRING", "STR"
        fld(NF).Type = dbText
      Case "TIME"
        fld(NF).Type = dbTime
    End Select
    If I > 0 Then fld(NF).Size = I
    fld(NF).Required = (InStr(S2, "R") > 0)
    Select Case fld(NF).Type
      Case dbText, dbMemo
        fld(NF).AllowZeroLength = (InStr(S2, "Z") > 0)
    End Select
  End If
Next C
NI = 0
For C = LBound(Indexes) To UBound(Indexes)
  If VarType(Indexes(C)) = vbString Then Z = Indexes(C) Else Z = ""
  If Len(Z) > 0 Then
    NI = NI + 1
    If InStr(Z, "|") = 0 Then
      S0 = Z
      S1 = ""
      S2 = ""
    Else
      I = InStrRev(Z, "|")
      S1 = Mid$(Z, I + 1)
      Z = Left$(Z, I - 1)
      If InStr(Z, "|") = 0 Then
        S0 = Z
      Else
        I = InStrRev(Z, "|")
        S0 = Mid$(Z, I + 1)
        S2 = Left$(Z, I - 1)
      End If
    End If
    If InStr(S2, "U") = 0 And InStr(S2, "*") > 0 Then S2 = S2 + "U"
    idx(NI).Name = S0
    idx(NI).Primary = (InStr(S2, "*") > 0)
    idx(NI).Unique = (InStr(S2, "U") > 0)
    idx(NI).IgnoreNulls = (InStr(S2, "N") > 0)
    N = UBound(Split(S1, ";")) - LBound(Split(S1, ";")) + 1
    S0 = ""
    For I = 1 To N
      Z = Split(S1, ";")(I - 1)
      If Left$(Z, 1) = "+" Then
        S2 = " Asc"
        Z = Mid$(Z, 2)
      ElseIf Left$(Z, 1) = "-" Then
        S2 = " Desc"
        Z = Mid$(Z, 2)
      Else
        S2 = ""
      End If
      If InStr(Z, " ") > 0 Then
        If Left$(Z, 1) <> "[" And Right$(Z, 2) <> "]" Then Z = "[" & Z & "]"
      End If
      If I > 1 Then S0 = S0 & ";"
      S0 = S0 & Z & S2
    Next I
    idx(NI).Fields = S0
  End If
Next C
Set td = New TableDef
td.Name = Name
For I = 1 To UBound(fld)
  td.Fields.Append fld(I)
Next I
For I = 1 To UBound(idx)
  td.Indexes.Append idx(I)
Next I
Erase fld, idx
Set CreateTableDef = td
Set td = Nothing
End Function


Код конечно давно устарел (он у меня со времен седой древности), но тем не менее работает.

Замечания: работает только для DAO, для ADO проще написать заново, чем переделывать этот код. Кстати, этим я и занимаюсь, делаю процедурку, которая будет считывать файл со структурой БД (файл будет храниться в ресурсном файле) и создавать БД с требуемой структурой и любым методом доступа (DAO, ADO, RDO).

[Ivan1]

Можно очень легко и просто сделать базу данных в
Accese только одно но надо делать в 97
а не в 2000
У меня сейчас стоит Accese2000 и я вышел из положения так
есть кокая то база созданная еще в 97 я ее переименовываю как мне
нравится ложу куда мне нравится и не надо никаких рабочих столов
потом открываю Accese 2000 с помощью конструктора создаю любую
таблицу какую мне нужно это не сложно
потом я ей делаю экспорт в базу данных старого образца и все
и начинаю с ней работать.

А теперь у меня встерчный вопрос
помоги если сможеш с datagrid у меня есть книга я ее читаю пытаюсь
делать а не чего не совпадает.
Удачи.

[VisMajor]

Я бы тебе не советовал останавливатся на DAO технологии, используй ADO. Результаты запроса я помещаю в ListView, все прописывать приходится в ручную, но как говорится - куда хочу туды верчу, одним словом РУЛЕЗ .

Приношу свои извенения! В меню Проэкт>>Информация нужно добавить Microsoft ActiveX Data Objects 2.1 Libray & Microsoft ActiveX Data Objects Recordset 2.7 Libray

Код: Выделить всё

Public cn As New ADODB.Connection  'Обявляем новый объект доступный всему проэкту
Public rst As New ADODB.Recordset  'Обявляем новый объект доступный всему проэкту

Private Sub Form_Load()
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security " & _
    "Info=True;Data Source=" & "Путь к твоей базе" & "\Temp.mdb;" & _
    "Mode=ReadWrite;" 'Устанавливаем соединение с базой
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cn.Close 'Закрываем соединение с базой
End Sub

Private Sub Text1_Change()
    Dim itmX As ListItem
    Dim q As Integer
    Dim SQL As String
    Dim W, E As String
    If O1(0).Value = True Then
        W = ""
        E = "%"
    Else
        W = "%"
        E = "%"
    End If
    SQL = "Select * From Plat Where pltOsn Like '" & W & Text1 & E & "'" 'Строим запрос
    ListView1.ListItems.Clear 'Обнуляем набор записей в компоненте
    rst.Open SQL, cn, adOpenKeyset, adLockOptimistic 'Открываем Рекордсет со следующими параметрами: запрос, используемое соединение, (не помню), режим доступа к используемым таблицам...
    If rst.RecordCount > 0 Then 'Если количество результирующих записей в  больше ноля ...
        ProgressBar1.Max = rst.RecordCount 'Задаем максимальное значение
    Else
        ProgressBar1.Max = 1
    End If
    ProgressBar1.Visible = True
    D.Caption = "" 'Это лабел - просто коряво обозваный
    K.Caption = "" 'Это лабел - просто коряво обозваный
    Zap.Caption = "" 'Это лабел - просто коряво обозваный
    For q = 1 To rst.RecordCount
        Zap.Caption = rst.RecordCount
        ProgressBar1.Value = q
        Set itmX = ListView1.ListItems.Add(, , rst.Fields(0), 0, 0) 'Добавляем запись в ListView1 и привязываем itmX к этой записи - после чего работая с itmX фактически работаеш с этой записью
            If Not IsNull(rst.Fields(1)) Then itmX.SubItems(1) = rst.Fields(1) 'Присваиваем значение подзаписи
            If Not IsNull(rst.Fields(2)) Then
                If rst.Fields(2) Then
                    itmX.SubItems(2) = "Дебет"
                    D.Caption = Str(Val(D.Caption) + rst.Fields(8))
                Else
                    itmX.SubItems(2) = "Кредит"
                    K.Caption = Str(Val(K.Caption) + rst.Fields(8))
                End If
            End If
            If Not IsNull(rst.Fields(3)) Then itmX.SubItems(3) = rst.Fields(3)
        rst.MoveNext 'Прерходим к следующей записи
    Next q
    rst.Close 'Закрываем Рекордсет


------------------------------------
С уважением Юрий.

[Ivan1]

Привет Юрий спосибо за помощ
я сделал все так как ты сказал
и сразу возниклио много вопросов
во первых при компиляции у меня дает ошибку
Run-time eror 91
Object variable or with block variable not set
что это значит?
во вторых базу данных мою где надо указывать вместо
слова temp?
и в третьих если тебе не трудно немогбы ты мне тоже самое прислать
только с комментариями или что то другое.

Часто люди падают с большой высоты из-за недостатков, которые помогли им ее достичь. [/img]

[VisMajor]

Я чуток добави предыдущую запись. Попробуй. Не получится, пиши что именно нужно прокоментировать.

------------------
С уважением, Юрий.

[Chuvak]

а как очистить всю БД

[Ivan1]

Если ты имеешь ввиду кодом то это элементарно.

Код: Выделить всё

'******очистка всей таблице в базе данных*********
Rst2.MoveFirst            'перехожу на первую запись
Do While Rst2.EOF = False 'делать пока не конец тоблицы
  Rst2.Delete             ' удалять текущую запись
  Rst2.MoveNext           'перехожу на следующую запись
Loop
Rst2.Update               'Сохраняю дазу данных
'******** и все **********************************

Но только перед этим надо не забыть подключиться к базе данных


DbName = App.Path & "\Baza.mdb" 'Имя базы данных
Tabname = "Zaivka"
Set crb = CreateWorkspace("", "admin", "", dbUseJet)
Set db = crb.OpenDatabase(DbName)
Set RST2 = db.OpenRecordset(Tabname, dbOpenTable) 'Открываю таблицу

И я вопрос хотел можно ли переписываться по почте с тобой
для того чтобы кто нибуть мог для меня на трудные вопросы отвечать.
мой email: ivan_svetl@mail.com

[VisMajor]

Смотри новые дополнения в выше приведенном коде...

С уважение, Юрий.

[AlexKonev]

Можно очень легко и просто сделать базу данных в
Accese только одно но надо делать в 97
а не в 2000 ...

ну и зачем такой гемор? делать в 97 потом перетаскивать в 2000 - делай сразу в 2000!

а если VB не хочет работать с Access 2000, то надо поставить сервис пак номер 5 и забыть про гемор.

[Ivan1]

Нашел очень интересную статью на счет создать базу данных кодом
там как базу данных создать
как таблицы в базе создать и многое другое
вот сылочка [url]vbrussian.com/Article.asp?ID=78[/url]
и еще продолжение[url]vbrussian.com/Article.asp?ID=80[/url]