Option ExplicitPrivate CAT As ADOX.CatalogPublic Sub CreateMDB(ByVal Path As String)
On Error GoTo ErrTrap Set CAT = New ADOX.Catalog If Right$(Path, 1) = "\" Then Path = Left$(Path, Len(Path) - 1)' ===[Create Database]===
CAT.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & "\DEMO.mdb;" & _
"Jet OLEDB:Database Password=;" & _
"Jet OLEDB:Engine Type=5;" CreateTables
CreateIndexes
CreateKeys Set CAT = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description
Exit Sub
Resume
End SubPrivate Sub CreateTables()
On Error GoTo ErrTrap
Dim TBL As ADOX.Table
Set TBL = New ADOX.Table' ===[Create Table 'Tablename']===
Set TBL = New ADOX.Table
TBL.Name = "Tablename"
TBL.Columns.Append "Add", adVarWChar, 50
TBL.Columns.Append "ID", adInteger, 0
TBL.Columns("ID").Properties("AutoIncrement") = True
TBL.Columns.Append "Name", adVarWChar, 50
TBL.Columns.Append "Pho", adLongVarBinary, 0
TBL.Columns.Append "Resume", adLongVarWChar, 0
TBL.Columns.Append "TypeID", adVarWChar, 50
CAT.Tables.Append TBL Set TBL = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateTables"
Exit Sub
Resume
End SubPrivate Sub CreateIndexes()
On Error GoTo ErrTrap
Dim IDX As ADOX.Index
Set IDX = New ADOX.Index' ===[Create Index 'PrimaryKey']===
Set IDX = New ADOX.Index
IDX.Name = "PrimaryKey"
IDX.Columns.Append "ID"
IDX.PrimaryKey = True
IDX.Unique = True
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsDisallow
CAT.Tables("Tablename").Indexes.Append IDX' ===[Create Index 'ID']===
Set IDX = New ADOX.Index
IDX.Name = "ID"
IDX.Columns.Append "ID"
IDX.PrimaryKey = False
IDX.Unique = False
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsAllow
CAT.Tables("Tablename").Indexes.Append IDX' ===[Create Index 'TypeID']===
Set IDX = New ADOX.Index
IDX.Name = "TypeID"
IDX.Columns.Append "TypeID"
IDX.PrimaryKey = False
IDX.Unique = False
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsAllow
CAT.Tables("Tablename").Indexes.Append IDX Set IDX = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateIndexes"
Exit Sub
Resume
End SubPrivate Sub CreateKeys()
On Error GoTo ErrTrap
Dim KEY As ADOX.KEY
Dim TBL As ADOX.Table Set KEY = New ADOX.KEY
Set TBL = New ADOX.Table Set KEY = Nothing
Set TBL = Nothing Exit Sub
ErrTrap:
Select Case Err.Number
Case -2147467259 ' Index already exists - Remove it...
CAT.Tables(TBL.Name).Indexes.Delete KEY.Name
Resume
Case Else
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateKeys"
Exit Sub
Resume
End Select
End Sub
需要详细注解,此是否为空间数据库
On Error GoTo ErrTrap Set CAT = New ADOX.Catalog If Right$(Path, 1) = "\" Then Path = Left$(Path, Len(Path) - 1)' ===[Create Database]===
CAT.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & "\DEMO.mdb;" & _
"Jet OLEDB:Database Password=;" & _
"Jet OLEDB:Engine Type=5;" CreateTables
CreateIndexes
CreateKeys Set CAT = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description
Exit Sub
Resume
End SubPrivate Sub CreateTables()
On Error GoTo ErrTrap
Dim TBL As ADOX.Table
Set TBL = New ADOX.Table' ===[Create Table 'Tablename']===
Set TBL = New ADOX.Table
TBL.Name = "Tablename"
TBL.Columns.Append "Add", adVarWChar, 50
TBL.Columns.Append "ID", adInteger, 0
TBL.Columns("ID").Properties("AutoIncrement") = True
TBL.Columns.Append "Name", adVarWChar, 50
TBL.Columns.Append "Pho", adLongVarBinary, 0
TBL.Columns.Append "Resume", adLongVarWChar, 0
TBL.Columns.Append "TypeID", adVarWChar, 50
CAT.Tables.Append TBL Set TBL = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateTables"
Exit Sub
Resume
End SubPrivate Sub CreateIndexes()
On Error GoTo ErrTrap
Dim IDX As ADOX.Index
Set IDX = New ADOX.Index' ===[Create Index 'PrimaryKey']===
Set IDX = New ADOX.Index
IDX.Name = "PrimaryKey"
IDX.Columns.Append "ID"
IDX.PrimaryKey = True
IDX.Unique = True
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsDisallow
CAT.Tables("Tablename").Indexes.Append IDX' ===[Create Index 'ID']===
Set IDX = New ADOX.Index
IDX.Name = "ID"
IDX.Columns.Append "ID"
IDX.PrimaryKey = False
IDX.Unique = False
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsAllow
CAT.Tables("Tablename").Indexes.Append IDX' ===[Create Index 'TypeID']===
Set IDX = New ADOX.Index
IDX.Name = "TypeID"
IDX.Columns.Append "TypeID"
IDX.PrimaryKey = False
IDX.Unique = False
IDX.Clustered = False
IDX.IndexNulls = adIndexNullsAllow
CAT.Tables("Tablename").Indexes.Append IDX Set IDX = Nothing Exit Sub
ErrTrap:
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateIndexes"
Exit Sub
Resume
End SubPrivate Sub CreateKeys()
On Error GoTo ErrTrap
Dim KEY As ADOX.KEY
Dim TBL As ADOX.Table Set KEY = New ADOX.KEY
Set TBL = New ADOX.Table Set KEY = Nothing
Set TBL = Nothing Exit Sub
ErrTrap:
Select Case Err.Number
Case -2147467259 ' Index already exists - Remove it...
CAT.Tables(TBL.Name).Indexes.Delete KEY.Name
Resume
Case Else
MsgBox Err.Number & " / " & Err.Description, , "Error In CreateKeys"
Exit Sub
Resume
End Select
End Sub
需要详细注解,此是否为空间数据库
解决方案 »
- 求问复选框与数据库中的布尔值连接的问题!!
- 如何加入鼠标滚轮改变窗体大小(窗内控件随之改变,但长宽比不能变)
- 如何测试一个连接对象是否正常呢?比如突然拔掉网线,这时conn的state 属性还是adstateopen呀?conn.errors.count也还是0?
- 为何使用strrpos、substr等会出现“子程序或函数未定义”
- 请问在VB中 实现能填入多行文本的功能怎么实现,textBox只能写一行阿
- 哪里能下到 True DBGrid Pro 8.0 ? 或 7.0 的注册机?
- 请问vb中如何调试com组件 谢谢
- 朋友,看看吧!
- 菜鸟提个问题,请大家不要吝啬帮我一下,学习就靠你们拉,虽然分数不多!拜托
- 各位大虾帮帮我!!
- 散分!
- 如何让子窗口关闭?
CAT.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & "\DEMO.mdb;" & _
"Jet OLEDB:Database Password=;" & _
"Jet OLEDB:Engine Type=5;"'建立表 Tablename
CreateTables
'建立索引 'ID'
CreateIndexes
'建立键
CreateKeys