男性大腿根部黑斑:vba操作MDB创建MDB　创建删除表　添加字段及删除 - ACCESS综合交流 - OF...

Dtype = vbCrLf & "OLE 对象-128" & vbCrLf & "备注-130" & vbCrLf & "超链接-130" & vbCrLf & "货币-6" & vbCrLf & "日期/时间-7" & vbCrLf & "是/否-11" & vbCrLf & "数字-3" & vbCrLf & "文本-130" & vbCrLf & "自动编号-3"


Sub 连接mdb() '打开数据库连接
Dbpath = ThisWorkbook.Path & "\my数据库.mdb"

set Cn = New ADODB.Connection

With Cn
.Provider = "microsoft.jet.oledb.4.0"
.ConnectionString = "data source=" & Dbpath & ";jet oledb:database password=" & "88547913"
.CursorLocation = adUseClient
.Open
End With
End Sub



Sub 显示数据库所有表()
If Cn.State = adStateClosed Then Call 连接mdb
Dim RS As ADODB.Recordset
Set RS = Cn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "table"))
Do Until RS.EOF
Set rsColumn = Cn.OpenSchema(4, Array(Empty, Empty, RS("Table_Name").Value))
Do Until rsColumn.EOF
mn = mn & vbCrLf & "字段名:" & rsColumn("Column_Name") & vbTab & "类型:" & getDataType(rsColumn("Data_Type")) & ","
rsColumn.MoveNext
Loop
MsgBox "表--" & RS!TABLE_NAME & mn
mn = ""
RS.MoveNext
Loop
End Sub



Sub 显示数据库字段名()
If Cn.State = adStateClosed Then Call 连接mdb
tnstr = InputBox("请输入表名")
Set rsColumn = Cn.OpenSchema(4, Array(Empty, Empty, tnstr))
Do Until rsColumn.EOF
cnstr = cnstr & rsColumn!column_Name & "-" & rsColumn("Data_Type") & ","
rsColumn.MoveNext
Loop
nn = MsgBox(cnstr, vbYesNo, "表--" & tnstr)
Strtextt = cnstr
Call 写文本
End Sub



Function getDataType(typeId)
On Error Resume Next
Select Case typeId
Case 130
getDataType = "文本"
Case 131
getDataType = "数值"
Case 2
getDataType = "整型"
Case 3
getDataType = "长整型"
Case 7
getDataType = "日期 / 时间"
Case 5
getDataType = "双精度型"
Case 11
getDataType = "是 / 否"
Case 128
getDataType = "OLE 对象"
Case Else
getDataType = typeId
End Select
End Function



Sub 创建mdb表()
On Error Resume Next
If Cn.State = adStateClosed Then Call 连接mdb
Strname = InputBox("请输入要创建的表名")
Sql = "CREATE TABLE " & Strname & " (" & InputBox("字段名") & " " & InputBox("类型" & Dtype) & ")"
Cn.Execute (Sql) 'rs.Open Sql, Cn
Cn.Close
Set Cn = Nothing
End Sub
Sub 删除mdb表()
If Cn.State = adStateClosed Then Call 连接mdb
Strname = InputBox("请输入要创建的表名")
Sql = "DROP Table " & Strname
Cn.Execute (Sql)
Cn.Close
Set Cn = Nothing
End Sub



Sub 添加字段()
If Cn.State = adStateClosed Then Call 连接mdb
tnstr = InputBox("请输入表名")
Sql = "ALTER TABLE " & tnstr & " ADD COLUMN " & InputBox("字段名") & " " & InputBox("字段类型--例如" & Dtype & Text(2))
Rst.Open Sql, Cn, adOpenDynamic, adLockOptimistic
Rst.Close: Set Rst = Nothing
End Sub


Sub 删除字段()
On Error Resume Next
If Cn.State = adStateClosed Then Call 连接mdb
tnstr = InputBox("请输入表名")
Sql = "Alter Table " & tnstr & " Drop Column " & InputBox("字段名")
Cn.Execute (Sql)
End Sub