EXCEL利用VBA进行数据库操作.xlsx

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 定义数据库名称 Dim myDataTableName As String 定义数据表名称 设置要创建的数据库名称 包括完整路径 myDatabaseName ThisWorkbook Path Data Source 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 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 Dim cnn As ADODB Connection Dim rs As ADODB Recordset mydata ThisWorkbook Path 客户管理 mdb 指定数据库 mytable 客户资料 指定数据表 mycolumn 客户名称 指定字段名称 建立与数据库的连接 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 If LCase rs column name LCase mycolumn Then MsgBox 在数据表 mytable 中存在字段 GoTo hhh End If rs MoveNext Loop MsgBox 在数据表 mytable 中不存在字段 mycolumn hhh rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 006 判断数据库中表头字段类型和大小 先引用Microsoft activex data objects 2 8 library 先引用microsoft ado ext 2 8 for dll and security 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 mydata ThisWorkbook Path 客户管理 mdb 指定数据库 mytable 客户信息 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 Set rs New ADODB Recordset rs Open mytable cnn adOpenKeyset adLockOptimistic 查询字段数据类型和大小 ActiveSheet Cells Clear ActiveSheet Range A1 C1 Array 字段名称 字段类型 字段大小 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 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 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 mydata ThisWorkbook Path 客户管理 mdb 指定数据库 mytable 客户信息 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 Set rs New ADODB Recordset rs Open mytable cnn adOpenKeyset adLockOptimistic 查询字段数据类型和大小 ActiveSheet Cells Clear ActiveSheet Range A1 C1 Array 字段名称 字段类型 字段大小 k 2 For Each myField In rs Fields 将字段名称 类型和大小输出到工作表 ActiveSheet Range A k myField Name ActiveSheet Range B k IntegerToVBAConstant myField Type ActiveSheet Range C k myField DefinedSize k k 1 Next rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub VBA常量名称与数字的转换函数 Function VBAConstantToInteger myVBAConstant As String As Integer Dim myInteger As Integer Select Case myVBAConstant Case adBigInt myInteger 20 Case adBinary myInteger 128 Case adBoolean myInteger 11 Case adBSTR myInteger 8 Case adChapter myInteger 136 Case adChar myInteger 129 Case adCurrency myInteger 6 Case adDate myInteger 7 Case adDBDate myInteger 133 Case adDBTime myInteger 134 Case adDBTimeStamp myInteger 135 Case adDecimal myInteger 14 Case adDouble myInteger 5 Case adEmpty myInteger 0 Case adError myInteger 10 Case adFileTime myInteger 64 Case adGUID myInteger 72 Case adIDispatch myInteger 9 Case adInteger myInteger 3 Case adIUnknown myInteger 13 Case adLongVarBinary myInteger 205 Case adLongVarChar myInteger 201 Case adLongVarWChar myInteger 203 Case adNumeric myInteger 131 Case adPropVariant myInteger 138 Case adSingle myInteger 4 Case adSmallInt myInteger 2 Case adTinyInt myInteger 16 Case adUnsignedBigInt myInteger 21 Case adUnsignedInt myInteger 19 Case adUnsignedSmallInt myInteger 18 Case adUnsignedTinyInt myInteger 17 Case adUserDefined myInteger 132 Case adVarBinary myInteger 204 Case adVarChar myInteger 200 Case adVariant myInteger 12 Case adVarNumeric myInteger 139 Case adVarWChar myInteger 202 Case adWChar myInteger 130 Case Else myInteger 1 End Select VBAConstantToInteger myInteger End Function 与数字与VBA常量名称转换函数 Function IntegerToVBAConstant myInteger As Integer As String Dim myVBAConstant As String Select Case myInteger Case 20 myVBAConstant adBigInt Case 128 myVBAConstant adBinary Case 11 myVBAConstant adBoolean Case 8 myVBAConstant adBSTR Case 136 myVBAConstant adChapter Case 129 myVBAConstant adChar Case 6 myVBAConstant adCurrency Case 7 myVBAConstant adDate Case 133 myVBAConstant adDBDate Case 134 myVBAConstant adDBTime Case 135 myVBAConstant adDBTimeStamp Case 14 myVBAConstant adDecimal Case 5 myVBAConstant adDouble Case 0 myVBAConstant adEmpty Case 10 myVBAConstant adError Case 64 myVBAConstant adFileTime Case 72 myVBAConstant adGUID Case 9 myVBAConstant adIDispatch Case 3 myVBAConstant adInteger Case 13 myVBAConstant adIUnknown Case 205 myVBAConstant adLongVarBinary Case 201 myVBAConstant adLongVarChar Case 203 myVBAConstant adLongVarWChar Case 131 myVBAConstant adNumeric Case 138 myVBAConstant adPropVariant Case 4 myVBAConstant adSingle Case 2 myVBAConstant adSmallInt Case 16 myVBAConstant adTinyInt Case 21 myVBAConstant adUnsignedBigInt Case 19 myVBAConstant adUnsignedInt Case 18 myVBAConstant adUnsignedSmallInt Case 17 myVBAConstant adUnsignedTinyInt Case 132 myVBAConstant adUserDefined Case 204 myVBAConstant adVarBinary Case 200 myVBAConstant adVarChar Case 12 myVBAConstant adVariant Case 139 myVBAConstant adVarNumeric Case 202 myVBAConstant adVarWChar Case 130 myVBAConstant adWChar Case Else myVBAConstant Error End Select IntegerToVBAConstant myVBAConstant End Function Public Sub 技巧12 008 从数据库总复制数据 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i With Range Cells 1 1 Cells 1 rs Fields Count Font Bold True HorizontalAlignment xlCenter End With 复制全部数据 Range A2 CopyFromRecordset rs 设置工作表格式 ActiveSheet Columns rs Fields Count NumberFormat yyyy mm dd ActiveSheet Columns AutoFit rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 009 取得固定列的数据 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select 姓名 班级 数学 语文 from mytable order by 学号 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i With Range Cells 1 1 Cells 1 rs Fields Count Font Bold True HorizontalAlignment xlCenter End With 复制全部数据 Range A2 CopyFromRecordset rs 设置工作表格式 ActiveSheet Columns AutoFit rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 010 获得某项的所有项名 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select distinct 班级 from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制全部数据 Range A1 CopyFromRecordset rs 设置工作表格式 rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 011 数学成绩大于等于90 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select top 10 from mytable where 数学 90 order by 数学 desc Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 012 姓郭的 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable where 姓名 like 郭 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 013 总分排名 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable order by 总分 DESC 数学 DESC 语文 DESC Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 014 一班数学在80 90之间的 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable where 班级 初一1班 and 数学 between 80 and 90 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 015 多项选择 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable where 班级 初一1班 and 性别 男 and 数学 95 or 语文 95 and year 日期 2006 and month 日期 7 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 016 数学最高分和最低分 先引用Microsoft activex data objects 2 8 library Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select max 数学 as math1 min 数学 as math2 from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制数据 Range A1 B1 Array 数学最高分 数学最低分 Range A2 B2 Array rs math1 rs math2 rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 017 各班级平均分 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ClassTotal As Integer Dim myArray As Variant ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询不重复的班级名称 SQL select distinct 班级 from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic ClassTotal rs RecordCount ReDim myclass 1 To ClassTotal For i 1 To ClassTotal myclass i rs Fields 班级 rs MoveNext Next i myArray Array 数学 语文 物理 化学 英语 体育 总分 Range A1 班级 Range B1 H1 myArray 开始查询各科的平均分 For i 1 To ClassTotal Cells i 1 1 myclass i For j 0 To UBound myArray SQL select avg myArray j as myAvg from mytable where 班级 myclass i Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic Cells i 1 j 2 Round rs myAvg 2 Next j Next i rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 018 初一2班学生中数学成绩大于平均分的 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select select avg 数学 as mathAvg from mytable where 班级 初一2班 from mytable where 班级 初一2班 and 数学 select avg 数学 from mytable where 班级 初一2班 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs Range A1 班级数学平均分 rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 019 各班级学生的各课程和总分的平均分 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset ActiveSheet Cells Clear mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With SQL select 班级 avg 数学 as 数学平均 avg 语文 as 语文平均 avg 物理 as 物理平均 avg 化学 as 化学平均 avg 英语 as 英语平均 avg 体育 as 体育平均 avg 总分 as 总分平均 from mytable group by 班级 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 复制字段名 For i 1 To rs Fields Count Cells 1 i rs Fields i 1 Name Next i 复制全部数据 Range A2 CopyFromRecordset rs rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 020 窗体显示班级 学生信息 UserForm1 Show End Sub Dim cnn As ADODB Connection Dim mydata As String mytable As String Private Sub CommandButton1 Click End End Sub Private Sub ListBox1 Click Dim SQL As String Dim i As Integer Dim rs As ADODB Recordset 查询某个班级的所有学生姓名 SQL select 姓名 from mytable where 班级 ListBox1 Value Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 将学生姓名为列表框ListBox2设置项目 With ListBox2 Clear For i 1 To rs RecordCount AddItem rs Fields 姓名 rs MoveNext Next i End With End Sub Private Sub ListBox2 Click Dim SQL As String Dim i As Integer Dim nyArray As Variant Dim rs As ADODB Recordset myArray Array 数学 语文 物理 化学 英语 体育 总分 查询某个学生的考试成绩 SQL select 数学 语文 物理 化学 英语 体育 总分 from mytable where 班级 ListBox1 Value and 姓名 ListBox2 Value Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 将学生的成绩显示在文字框中 For i 0 To UBound myArray Me Controls myArray i Value rs Fields i Next i End Sub Private Sub UserForm Initialize Dim SQL As String Dim i As Integer mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询不重复的班级名称 SQL select distinct 班级 from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 将班级名称为列表框ListBox1设置项目 With ListBox1 For i 1 To rs RecordCount AddItem rs Fields 班级 rs MoveNext Next i End With End Sub Public Sub 技巧12 021 添加学生成绩 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset Dim i As Integer Dim myArray As Variant myArray Array CY100 魏喜 男 初一5班 95 88 92 84 93 80 532 7 6 2006 mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 查询数据表 SQL select from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic 添加记录 rs AddNew For i 0 To rs Fields Count 1 rs Fields i myArray i Next i rs Update rs Close cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 022 将学号为CY005的学生数学成绩改为92 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 将学号为CY005的学生的数学成绩修改为92 SQL update mytable set 数学 92 where 学号 CY005 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 023 将学号为CY100的学生记录删除 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable 考试成绩 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 将学号为CY100的学生记录删除 SQL delete from mytable where 学号 CY100 Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic cnn Close Set rs Nothing Set cnn Nothing End Sub Public Sub 技巧12 024 将全部记录删除 Dim mydata As String mytable As String SQL As String Dim cnn As ADODB Connection Dim rs As ADODB Recordset mydata ThisWorkbook Path 成绩管理 mdb 指定数据库 mytable hhh 指定数据表 建立与数据库的连接 Set cnn New ADODB Connection With cnn Provider microsoft jet oledb 4 0 Open mydata End With 将全部记录删除 SQL delete from mytable Set rs New ADODB Recordset rs Open SQL cnn adOpenKeyset adLockOptimistic cnn Close Set rs Nothing Set cnn Nothing End