Option Explicit
'===================================================================================
'引用：Microsoft DAO 3.51 Object Library
'===================================================================================
Private dbDataBase As DAO.Database '本模块内的数据库对象
Private tdTable As DAO.TableDef '本模块内的表对象
Private fldField As DAO.Field '本模块内的字段对象
'新建一个数据库，cDataBase(数据库的路径,数据库的密码（可选，默认空）)
Public Function cDataBase(ByVal PathFile As String, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = CreateDatabase(PathFile, dbLangGeneral, dbEncrypt)
dbDataBase.NewPassword " ", Password
Set dbDataBase = Nothing
cDataBase = (Err.Number = 0)
End Function
'新建一个表，必须有一个字段，cTable(数据库的路径,新建的表名,第一个字段名,字段的类型,字段的大小,这个数据库的密码（可选，默认空）)
Public Function cTable(ByVal MdbFile As String, ByVal TableName As String, ByVal DefaultFieldName As String, ByVal FieldType As DAO.DataTypeEnum, ByVal FieldSize As Long, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd= " & Password & "; ")
Set tdTable = dbDataBase.CreateTableDef(TableName)
Set fldField = tdTable.CreateField(DefaultFieldName, FieldType, FieldSize)
tdTable.Fields.Append fldField
dbDataBase.TableDefs.Append tdTable
Set fldField = Nothing
Set tdTable = Nothing
Set dbDataBase = Nothing
cTable = (Err.Number = 0)
End Function
'重命名一个表，ReNameTable(数据库的路径,旧的表名,新的表名,这个数据库的密码（可选，默认空）)
Public Function ReNameTable(ByVal MdbFile As String, ByVal OldTable As String, ByVal NewTable As String, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd= " & Password & "; ")
Dim i As Long
For i = 0 To dbDataBase.TableDefs.Count - 1
Set tdTable = dbDataBase(i)
If tdTable.Name = OldTable Then Exit For
Set tdTable = Nothing
Next
tdTable.Name = NewTable
ReNameTable = (Err.Number = 0)
End Function
'新建一个字段，cField(数据库的路径,表名,字段名,字段的类型,字段的大小,这个数据库的密码（可选，默认空）)
Public Function cField(ByVal MdbFile As String, ByVal TableName As String, ByVal FieldName As String, ByVal FieldType As DAO.DataTypeEnum, ByVal FieldSize As Long, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd= " & Password & "; ")
Dim i As Long
For i = 0 To dbDataBase.TableDefs.Count - 1
Set tdTable = dbDataBase(i)
If tdTable.Name = TableName Then Exit For
Set tdTable = Nothing
Next
Set fldField = tdTable.CreateField(FieldName, FieldType, FieldSize)
tdTable.Fields.Append fldField
Set fldField = Nothing
Set tdTable = Nothing
Set dbDataBase = Nothing
cField = (Err.Number = 0)
End Function
'删除一个表，dTable(数据库的路径,删除的表名,这个数据库的密码（可选，默认空）)
Public Function dTable(ByVal MdbFile As String, ByVal TableName As String, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd= " & Password & "; ")
dbDataBase.TableDefs.Delete (TableName)
Set dbDataBase = Nothing
dTable = (Err.Number = 0)
End Function
'删除一个字段，dField(数据库的路径,表名,字段名,这个数据库的密码（可选，默认空）)
Public Function dField(ByVal MdbFile As String, ByVal TableName As String, ByVal FieldName As String, Optional ByVal Password As String = " ") As Boolean
On Error Resume Next
Set dbDataBase = DAO.OpenDatabase(MdbFile, True, False, ";pwd= " & Password & "; ")
Dim i As Long
For i = 0 To dbDataBase.TableDefs.Count - 1
Set tdTable = dbDataBase(i)
If tdTable.Name = TableName Then Exit For
Set tdTable = Nothing
Next
tdTable.Fields.Delete (FieldName)
Set tdTable = Nothing
Set dbDataBase = Nothing
dField = (Err.Number = 0)
End Function
本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请
点击举报。
