“ 数据库的表名，字段，字段信息的显示。数据表和字段的添加，删除，重命名等操作。”
01
—
窗体实例
第一部分：数据库维护窗体
第二部分：创建数据表窗体
02
—
代码实例
思路分析：
一、窗体相关代码
1.过程：
过程1：获取数据表清单，用于列表框刷新数据
过程2：获取字段清单，并显示在‘字段’列表框中
过程3：获取字段信息，并显示文本框中
2.加载窗体和退出窗体事件：
加载窗体：加载窗体时，建立数据库连接，并刷新"数据库"列表框的信息
退出窗体：按钮退出
3.自定义函数：
自定义函数，用于将数据类型整数值转换为类型字符串
二、列表框和输入框相关代码
1.'数据表'列表框，单击选择时刷新所选表的字段列表
2.'字段'列表框，单击选择时获取字段信息
三、数据表相关操作代码
1.创建数据表：显示创建数据表窗体，获取数据表清单
2.移除数据表
- 判断是否选择了要删除的数据表
- 确认是否删除选择的数据表
- 删除选定的数据表
- 刷新"数据表清单"列表框
- 删除"字段清单"列表框中的项目
3.重命名数据表
- 判断是否选择了要重命名的数据表
- 确认是否重命名选择的数据表
- 指定数据表的新名称
- 检查是否存在同名的数据表
- 查询原数据表，生成新表名，删除原表达到重命名的效果
- 刷新"数据表清单"列表框
- 删除"字段清单"列表框中的项目
4.备份数据表
- 判断是否选择了要备份的数据表
- 确认是否备份选择的数据表
- 指定数据表的新名称
- 查是否存在同名的数据表
- 利用生成表查询达到备份的效果
- 刷新"数据表清单"列表框
- 删除"字段清单"列表框中的项目
四、字段操作相关代码
1.添加字段
- 判断是否选择了要添加字段的数据表
- 指定新字段名称
- 确认是否添加字段
- 检查是否存在同名的数据表
- 添加字段
- 刷新"字段清单"列表框
2.删除字段
3.改变字段类型
4.改变字段大小
Option Explicit'一、窗体相关代码'1.加载窗体时，建立数据库连接，并刷新"数据库"列表框的信息Private Sub UserForm_Initialize() '1.建立数据库的连接 Call 数据库连接 '2.调用自定义过程，为"数据库表清单"列表框刷新数据 Call 获取数据表清单 End Sub'2.过程1：获取数据表清单，用于列表框刷新数据Public Sub 获取数据表清单() Set rs = cnn.OpenSchema(adSchemaTables) '获取数据表的所有表名到记录集中 With 数据表清单 '数据表清单为'数据表’列表框 .Clear Do Until rs.EOF '循环记录集的所有记录，找出表名称 If rs!table_type = "TABLE" Then .AddItem rs!table_name '将满足条件的表名称添加到列表中 End If rs.MoveNext Loop .ListStyle = fmListStyleOption '设置每个选项有单选按钮 End With rs.Close Set rs = Nothing End Sub'3.过程2：获取字段清单，并显示在‘字段’列表框中Public Sub 获取字段清单() Dim sql As String, i As Integer Set rs = New ADODB.Recordset '查询数据表，将字段名清单设置给'字段'列表框 sql = "select * from " & 数据表清单.Text '选中对象的文本 Set rs = New ADODB.Recordset rs.Open sql, cnn, adOpenKeyset, adLockOptimistic With 字段清单 .Clear For i = 0 To rs.Fields.Count - 1 .AddItem rs.Fields(i).name Next .ListStyle = fmListStyleOption End With rs.Close Set rs = Nothing End Sub'4.过程3：获取字段信息，并显示文本中Public Sub 获取字段信息() Dim sql As String, i As Integer '查询选中的数据表 sql = "select * from " & 数据表清单.Text Set rs = New ADODB.Recordset rs.Open sql, cnn, adOpenKeyset, adLockOptimistic '将字段的名称，类型，大小输出到对应的文本框中 字段名称.Value = rs.Fields(字段清单.Text).name '字段名称 字段类型.Value = IntToString(rs.Fields(字段清单.Text).Type) '通过自定义函数获取字段类型名称 字段大小.Value = rs.Fields(字段清单.Text).DefinedSize '字段大小 rs.Close Set rs = NothingEnd Sub'5.自定义函数，用于将数据类型整数值转换为类型字符串Function IntToString(MyInt As Integer) As String Dim MyStr As String '定义类型字符串变量，用于存储转换后的类型字符串 ' 未更改完，感觉没什么卵用，而且抄起来很烦 Select Case MyInt Case 20: MyStr = "adBigInt" Case 128: MyStr = "adBigInt" Case 11: MyStr = "adBigInt" Case 8: MyStr = "adBigInt" Case 136: MyStr = "adBigInt" Case 129: MyStr = "adBigInt" Case 6: MyStr = "adBigInt" Case 7: MyStr = "adBigInt" Case 133: MyStr = "adBigInt" Case 134: MyStr = "adBigInt" Case 135: MyStr = "adBigInt" Case 14: MyStr = "adBigInt" Case 5: MyStr = "adBigInt" Case 0: MyStr = "adBigInt" Case 10: MyStr = "adBigInt" Case 64: MyStr = "adBigInt" Case 72: MyStr = "adBigInt" Case 9: MyStr = "adBigInt" Case 3: MyStr = "adBigInt" Case 13: MyStr = "adBigInt" Case 205: MyStr = "adBigInt" Case 201: MyStr = "adBigInt" Case 203: MyStr = "adBigInt" Case 131: MyStr = "adBigInt" Case 138: MyStr = "adBigInt" Case 4: MyStr = "adBigInt" Case 2: MyStr = "adBigInt" Case 16: MyStr = "adBigInt" Case 21: MyStr = "adBigInt" Case 19: MyStr = "adBigInt" Case 18: MyStr = "adBigInt" Case 17: MyStr = "adBigInt" Case 132: MyStr = "adBigInt" Case 204: MyStr = "adBigInt" Case 200: MyStr = "adBigInt" Case 12: MyStr = "adBigInt" Case 139: MyStr = "adBigInt" Case 202: MyStr = "adBigInt" Case 130: MyStr = "adBigInt" Case Else: MyStr = "Error" End Select IntToString = MyStr End Function'6.窗体退出Private Sub 退出_Click() cnn.Close Set rs = Nothing Set cnn = Nothing Unload 数据表维护End Sub'二、列表框和输入框相关代码'1.'数据表'列表框，单击选择时刷新所选表的字段列表Private Sub 数据表清单_Click() Call 获取字段清单End Sub'2.'字段'列表框，单击选择时获取字段信息Private Sub 字段清单_Click() Call 获取字段信息End Sub'三、数据表相关操作代码'1.创建数据表Private Sub 创建数据表_Click() 创建数据表窗体.Show Call 获取数据表清单End Sub'2.移除数据表Private Sub 移除数据表_Click() Dim sql As String '判断是否选择了要删除的数据表 If 数据表清单.ListIndex = -1 Then MsgBox "没有选择要删除的数据表！", vbCritical, "警告" Exit Sub End If '确认是否删除选择的数据表 If MsgBox("是否删除数据表? ", vbQuestion + vbYesNo) = vbNo _ Then Exit Sub '删除选定的数据表 sql = "drop table " & 数据表清单.Text cnn.Execute sql MsgBox "数据库 & 数据表清单.Text & ">被成功删除！", vbInformation + vbOKOnly, "删除数据表" '刷新"数据表清单"列表框 Call 获取数据表清单 '删除"字段清单"列表框中的项目 字段清单.ClearEnd Sub'3.重命名数据表Private Sub 重命名数据表_Click() Dim sql As String, mynewname As String '判断是否选择了要重命名的数据表 If 数据表清单.ListIndex = -1 Then MsgBox "没有选要重命名的数据表！", vbCritical, "警告" Exit Sub End If '确认是否重命名选择的数据表 If MsgBox("是否重命名数据表? ", vbQuestion + vbYesNo) = vbNo _ Then Exit Sub restart: '指定数据表的新名称 mynewname = InputBox("请输入数据表新名称：", "输入数据表名称") If Len(Trim(mynewname)) = 0 Then 'trim函数可以去除空格 MsgBox "没有输入有效的数据表名称！", vbCritical, "警告" Exit Sub End If '检查是否存在同名的数据表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox "数据表 & mynewname & ">已经存在，请重新输入！", vbCritical, "警告" GoTo restart End If rs.MoveNext Loop '查询原数据表，生成新表名，删除原表达到重命名的效果 sql = "select * into " & mynewname & " from " & 数据表清单.Text cnn.Execute sql sql = "drop table " & 数据表清单.Text cnn.Execute sql MsgBox "成功将数据表名称改为 mynewname & ">", vbInformation + vbOKOnly, "数据表重命名" '刷新"数据表清单"列表框 Call 获取数据表清单 '删除"字段清单"列表框中的项目 字段清单.Clear Set rs = NothingEnd Sub'4.备份数据表Private Sub 备份数据表_Click() Dim sql As String, mynewname As String '判断是否选择了要备份的数据表 If 数据表清单.ListIndex = -1 Then MsgBox "没有选则要备份的数据表！", vbCritical, "警告" Exit Sub End If '确认是否备份选择的数据表 If MsgBox("是否备份数据表 & 数据表清单.Text & ">? ", vbQuestion + vbYesNo) = vbNo _ Then Exit Sub restart: '指定数据表的新名称 mynewname = InputBox("请输入数据表新名称：", "输入数据表名称") If Len(Trim(mynewname)) = 0 Then 'trim函数可以去除空格 MsgBox "没有输入有效的数据表名称！", vbCritical, "警告" Exit Sub End If '检查是否存在同名的数据表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox "数据表已经存在，请重新输入！", vbCritical, "警告" GoTo restart End If rs.MoveNext Loop '利用生成表查询达到备份的效果 sql = "select * into " & mynewname & " from " & 数据表清单.Text cnn.Execute sql MsgBox "成功将数据表 & 数据表清单.Text & ">备份，名称为 & _ mynewname & ">", vbInformation + vbOKOnly, "备份数据表" '刷新"数据表清单"列表框 Call 获取数据表清单 '删除"字段清单"列表框中的项目 字段清单.Clear Set rs = Nothing End Sub'四、字段操作相关代码'1.添加字段Private Sub 添加字段_Click() Dim sql As String, mynewfield As String '判断是否选择了要添加字段的数据表 If 数据表清单.ListIndex = -1 Then MsgBox "没有选要添加字段的数据表！", vbCritical, "警告" Exit Sub End If restart: '指定新字段名称 mynewfield = InputBox("请输入新字段名称：", "输入新字段") If Len(Trim(mynewfield)) = 0 Then 'trim函数可以去除空格 MsgBox "没有输入有效的字段名！", vbCritical, "警告" Exit Sub End If '确认是否添加字段 If MsgBox("是否向数据表 & 数据表清单.Text & ">中添加字段 _ & mynewfield & ">? ", vbQuestion + vbYesNo) = vbNo _ Then Exit Sub '检查是否存在同名的数据表 Set rs = cnn.OpenSchema(adSchemaColumns) Do Until rs.EOF If LCase(rs!column_name) = LCase(mynewfield) Then MsgBox "数据表中已经存在字段 & mynewfield & ">，请重新输入！", vbCritical, "警告" GoTo restart End If rs.MoveNext Loop '添加字段 sql = "alter table " & 数据表清单.Text & " add " & mynewfield & " text(50)" cnn.Execute sql MsgBox "数据表 & 数据表清单.Text & ">中成功添加了字段 & _ mynewfield & ">", vbInformation + vbOKOnly, "添加字段" '刷新"字段清单"列表框 Call 获取字段清单 Set rs = NothingEnd Sub'2.删除字段Private Sub 删除字段_Click() '略...同添加字段类似End Sub'3.改变字段类型Private Sub 改变字段类型_Click() '略...同添加字段类似End Sub'4.改变字段大小Private Sub 改变字段大小_Click() '略...同添加字段类似End Sub一、窗体相关代码
1.初始化窗体：将光标移到输入文本框，便于用户输入
2.当光标进入字段字符串的输入框时，将里面的实例文本清空
二、按钮相关代码
1.确认按钮
- 检查数据表是否已经存在
- 创建数据表
2.取消按钮
关闭创建数据表窗体
'一、窗体相关代码'说明：字段字符串的MultiLine 设置为TRUE,多行显示'1.初始化窗体Private Sub UserForm_Initialize() 字段字符串.Text = "字段1 Text(50) Date,字段3 single not null" 数据表名.SetFocus '将光标移到输入文本框，便于用户输入End Sub'2.当光标进入字段字符串的输入框时，将里面的实例文本清空Private Sub 字段字符串_Enter() 字段字符串.Text = ""End Sub'二、按钮相关代码'1.确认按钮Private Sub 确认_Click() Dim sql As String '检查数据表是否已经存在 Set rs = cnn.OpenSchema(adSchemaTables) '获取数据表的所有表名到记录集中 Do Until rs.EOF If LCase(rs!table_name) = LCase(数据表名.Value) Then MsgBox "数据表已经存在！" 数据表名.Text = "" 数据表名.SetFocus Exit Sub End If rs.MoveNext Loop '创建数据表 sql = "create table " & 数据表名.Text & Space(1) & "(" & 字段字符串.Text & ")" cnn.Execute sql MsgBox "数据表创建成功！", vbExclamation, "创建数据表" Unload 创建数据表窗体 rs.Close Set rs = NothingEnd Sub'2.取消按钮Private Sub 取消_Click() Unload 创建数据表窗体End Sub本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
