EXCEL利用VBA进行数据库操作

k=k+1
End If
Next i
Set mycat.ActiveConnection = Nothing
End Sub
Public Sub 技巧12_005()'判断数据表中是否存在字段
'先引用Microsoft activex data objects 2.8 library
Dim mydata As String, mytable As String, mycolumn As String
Set myCmd.ActiveConnection = cnn
myCmd.CommandText = "CREATE TABLE " & myDataTableName & _
"(客户编号 text(10),客户名称 text(30),联系地址 text(50)," _
& "联系电话 text(20),联系人 text(10),Email text(50))"
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
mydata = ThisWorkbook.Path & "\客户管理.mdb" '指定数据库
mytable = "客户资料"
'指定数据表
mycolumn = "客户名称"
'指定字段名称
'建立与数据库的连接
myCmd.Execute , , adCmdText
cnn.Close
Set cnn = Nothing
Set myCat = Nothing
Set myCmd = Nothing
'弹出信息
MsgBox "创建数据库成功！" & vbCrLf _
& "数据库文件名为：" & myDatabaseName & vbCrLf _
Do Until rs.EOF
If LCase(rs!table_name) = LCase(mytable) Then
MsgBox "数据表 < " & mytable & "> 存在！"
GoTo hhh
End If
rs.MoveNext
Loop
MsgBox "数据表 " & mytable & " 不存在！"
k=2
For Each myField In rs.Fields
'将字段名称、类型和大小输出到工作表
ActiveSheet.Range("A" & k) = myField.Name
ActiveSheet.Range("B" & k) = myField.Type
ActiveSheet.Range("C" & k) = myField.DefinedSize
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open mydata
End With
'开始检查该字段是否存在
Set rs = cnn.OpenSchema(adSchemaColumns)
Do Until rs.EOF
myDatabase.TableDefs.Append myDataTable
Set myDatabase = Nothing '释放变量
'弹出信息
MsgBox "创建数据库成功！" & vbCrLf _
& "数据库文件名为：" & myDatabaseName & vbCrLf _
& "数据表名称为：" & myDataTableName & vbCrLf _
Public Sub 技巧12_001()'创建数据库文件mdb
'先引用Microsoft dao 3.6 object library
Dim myDatabase As DAO.Database '定义数据库变量
Dim myDataTable As DAO.TableDef '定义数据表变量
Dim myDatabaseName As String
mydata = ThisWorkbook.Path & "\客户管理.mdb" '指定数据库
mytable = "客户信息"
'指定数据表
'建立与数据库的连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
Dim mydata As String, mytable As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
mydata = ThisWorkbook.Path & "\客户管理.mdb" '指定数据库文件
mytable = "客户信息"
On Error Resume Next
Kill myDatabaseName
On Error GoTo 0
'创建数据库文件
Set myDatabase = CreateDatabase(myDatabaseName, dbLangGeneral)
'创建数据表
Set myDataTable = myDatabase.CreateTableDef(myDataTableName)
.Open mydata
End With
'查询数据表
Set rs = New ADODB.Recordset
rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic
'查询字段数据类型和大小
ActiveSheet.Cells.Clear
ActiveSheet.Range("A1:C1") = Array("字段名称", "字段类型", "字段大小")
Dim mycat As New ADOX.Catalog
mydata = ThisWorkbook.Path & "\客户管理.mdb" '指定数据库文件
'建立与数据库的连接
mycat.ActiveConnection = "Provider=microsoft.jet.oledb.4.0;" _
& "保存位置：当前工作簿所在的文件夹。", _
vbOKOnly + vbInformation, "创建数据库"
End Sub
Public Sub 技巧12_002()'创建数据库
'先引用Microsoft activex data objects 2.8 library
'先引用microsoft ado ext.2.8 for dll and security
'为数据表添加字段
With myDataTable
.Fields.Append .CreateField("客户编号", dbText, 10)
.Fields.Append .CreateField("客户名称", dbText, 30)
.Fields.Append .CreateField("联系地址", dbText, 50)
myCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myDatabaseName
Set cnn = myCat.ActiveConnection
'创建数据表“客户信息”
Set myCmd = New ADODB.Command
hhh:
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
Public Sub 技巧12_004()与数据库链接，并取得表头
'先引用microsoft ado ext.2.8 for dll and security
Dim mydata As String
If LCase(rs!column_name) = LCase(mycolumn) Then
MsgBox "在数据表" & mytable & "中存在字段< " & mycolumn & ">！"
GoTo hhh
End If
rs.MoveNext
Loop
MsgBox "在数据表 " & mytable & "中不存在字段 " & mycolumn & "！"
Dim mydata As String, mytable As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim myField As ADODB.Field
Dim FieldType As String, FieldLong As Integer
Dim myCat As New ADOX.Catalog
Dim cnn As ADODB.Connection
Dim myCmd As ADODB.Command
Dim myDatabaseName As String
Dim myDataTableName As String
'设置包括完整路径的数据库文件名
myDatabaseName = ThisWorkbook.Path & "\客户管理.mdb"
myDataTableName = "客户信息"
'如果有同名的数据库文件，就删除它
On Error Resume Next
Kill myDatabaseName
On Error GoTo 0
'创建新数据库文件
& "数据表名称为：" & myDataTableName & vbCrLf _
& "保存位置：当前工作簿所在的文件夹。", _
vbOKOnly + vbInformation, "创建数据库"
End Sub链接到数据库
Public Sub 技巧12_003()'判断数据表是否存在
'先引用Microsoft activex data objects 2.8 library
& "Data Source=" & mydata
Msg = ""
k=1
For i = 0 To mycat.Tables.Count - 1
If Left(mycat.Tables.Item(i).Name, 4) <> "MSys" Then
ActiveSheet.Cells(k, 1) = mycat.Tables.Item(i).Name
Dim mydata As String, mytable As String
'定义数据库名称
Dim myDataTableName As String
'定义数据表名称
'设置要创建的数据库名称（包括完整路径）
myDatabaseName = ThisWorkbook.Path & "\客户管理.mdb"
'设置要创建的数据表名称
myDataTableName = "客户信息"
'删除已经存在的数据库文件
.Fields.Append .CreateField("联系电话", dbText, 20)
.Fields.Append .CreateField("联系人", dbText, 10)
.Fields.Append .CreateField("Email", dbText, 50)
End With
' Append方法将这些字段添加到TableDef对象的Fields集合里
hhh:
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
Public Sub 技巧12_006()'判断数据库中表头字段类型和大小
Hale Waihona Puke Baidu
'先引用Microsoft activex data objects 2.8 library
'先引用microsoft ado ext.2.8 for dll and security
k=k+1
Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
Public Sub 技巧12_007()'判断数据库中表头字段类型和大小
'先引用Microsoft activex data objects 2.8 library
'先引用microsoft ado ext.2.8 for dll and security
'指定要查询的数据表名称
'建立与数据库的廉洁
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open mydata
End With
'开始查询是否存在该数据表
Set rs = cnn.OpenSchema(adSchemaTables)