module3.bas

信息管理数据库

Attribute VB_Name = "Module3"
 Option Explicit
' Data 控件使用有密码的 Access 数据库
'使用 Data 控件打开 Accecc 数据库：
 ' 设置 Connect  属性为 ;pwd=密码
'  Data1.Connect = ";pwd=密码"
'修改密码:
'  Data1.Database.NewPassword  _老密码_, _新密码_
  
 Public Sub New_click()
 On Error GoTo Err100
   '建立数据库
   CreateDatabase frmData.mdbFile, dbLangGeneral
   cmdNumbel_Click
   Exit Sub
   
Err100:
   MsgBox "数据库建立失败!    " & vbCrLf & vbCrLf & Err.Description, vbInformation

End Sub
Public Sub cmdCreate_Click()

   On Error GoTo Err100
 
 '定义表与字段
 Dim DefDatabase As Database
 Dim DefTable As TableDef, DefField As Field
 If frmData.DataNumbel + 1 > 5 Then
       MsgBox "最多能建立五个数据表！"
       Exit Sub
 End If
 frmData.mdbDataName = "Data" & CStr(frmData.DataNumbel + 1)
 
 Set DefDatabase = Workspaces(0).OpenDatabase(frmData.mdbFile, 0, False) '(App.Path & "\VB-CODE.MDB", 0, False)
 Set DefTable = DefDatabase.CreateTableDef(frmData.mdbDataName)
 
 'dbBinary = 9
 'dbBoolean = 1
 'dbByte = 2
 'dbChar=18
 'dbDate=8
 'dbInteger=3
 'dbLong=4
 'dbMemo=12
 'dbText=10
 
 '建立Name字段为8个字符型
  Set DefField = DefTable.CreateField("Name", dbText, 10)
   '字段追加
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Oicq", dbText, 8)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Love", dbText, 20)
      DefTable.Fields.Append DefField
  Set DefField = DefTable.CreateField("Sex", dbText, 2)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Year", dbDate, 8)
      DefTable.Fields.Append DefField
  Set DefField = DefTable.CreateField("Age", dbInteger, 3)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Constell", dbText, 8)
      DefTable.Fields.Append DefField
  Set DefField = DefTable.CreateField("Attributive", dbText, 8)
      DefTable.Fields.Append DefField
  Set DefField = DefTable.CreateField("Blood", dbText, 8)
      DefTable.Fields.Append DefField
  
  Set DefField = DefTable.CreateField("Address", dbText, 255)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("TelepNo", dbText, 20)
      DefTable.Fields.Append DefField

  Set DefField = DefTable.CreateField("MoveCall", dbText, 15)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Home", dbText, 20)
      DefTable.Fields.Append DefField
  
  Set DefField = DefTable.CreateField("Call", dbText, 20)
      DefTable.Fields.Append DefField
      
  Set DefField = DefTable.CreateField("Fax", dbText, 50)
      DefTable.Fields.Append DefField
  
  Set DefField = DefTable.CreateField("Email", dbText, 50)
      DefTable.Fields.Append DefField
  
  Set DefField = DefTable.CreateField("Appendix", dbText, 255)
      DefTable.Fields.Append DefField
  
 '该字段允许为空
    '  DefField.AllowZeroLength = True
 '表追加
  DefDatabase.TableDefs.Append DefTable
  
  MsgBox " 数据表建立完成！    ", vbInformation
 
  Exit Sub
  
Err100:
  MsgBox "对不起，建立表失败。", vbCritical
   
End Sub
Public Sub cmdNumbel_Click()
   On Error GoTo Err100
 '定义表与字段
 Dim DefDatabase As Database
 Dim DefTable As TableDef, DefField As Field
 Set DefDatabase = Workspaces(0).OpenDatabase(frmData.mdbFile, 0, False) '(App.Path & "\VB-CODE.MDB", 0, False)
 Set DefTable = DefDatabase.CreateTableDef("mdbNumbel")
 
 '建立ID字段为8个字符型
  Set DefField = DefTable.CreateField("ID", dbInteger, 3)
   '字段追加
      DefTable.Fields.Append DefField
 '建立Name字段为8个字符型
  Set DefField = DefTable.CreateField("Name", dbText, 10)
   '字段追加
      DefTable.Fields.Append DefField
      
 '建立Numbel字段为3
  Set DefField = DefTable.CreateField("Numbel", dbInteger, 3)
   '字段追加
      DefTable.Fields.Append DefField
      
 '表追加
  DefDatabase.TableDefs.Append DefTable
  
  MsgBox "数据库建立完成！ ", vbInformation
  Exit Sub
  
Err100:
   MsgBox "数据库建立失败!    " & vbCrLf & vbCrLf & Err.Description, vbInformation
 Kill frmData.mdbFile
   
End Sub