win32api 获取窗体中的按钮_Excel用VBA连接Access数据库窗体实例2

“ 数据库的表名，字段，字段信息的显示。数据表和字段的添加，删除，重命名等操作。”

01

—

窗体实例

                                       第一部分：数据库维护窗体

第二部分：创建数据表窗体

02

—

代码实例

思路分析：

一、窗体相关代码

1.过程：

    过程1：获取数据表清单，用于列表框刷新数据

    过程2：获取字段清单，并显示在‘字段’列表框中

    过程3：获取字段信息，并显示文本框中

2.加载窗体和退出窗体事件：

    加载窗体：加载窗体时，建立数据库连接，并刷新"数据库"列表框的信息

    退出窗体：按钮退出

3.自定义函数：

    自定义函数，用于将数据类型整数值转换为类型字符串

二、列表框和输入框相关代码

        1.'数据表'列表框，单击选择时刷新所选表的字段列表

        2.'字段'列表框，单击选择时获取字段信息

三、数据表相关操作代码

        1.创建数据表：显示创建数据表窗体，获取数据表清单

        2.移除数据表

1. 1. 判断是否选择了要删除的数据表

   2. 确认是否删除选择的数据表      

   3. 删除选定的数据表

   4. 刷新"数据表清单"列表框

   5. 删除"字段清单"列表框中的项目

        3.重命名数据表

1. 1. 判断是否选择了要重命名的数据表

   2. 确认是否重命名选择的数据表

   3. 指定数据表的新名称

   4. 检查是否存在同名的数据表

   5. 查询原数据表，生成新表名，删除原表达到重命名的效果

   6. 刷新"数据表清单"列表框

   7. 删除"字段清单"列表框中的项目

        4.备份数据表

1. 1. 判断是否选择了要备份的数据表

   2. 确认是否备份选择的数据表

   3. 指定数据表的新名称

   4. 查是否存在同名的数据表

   5. 利用生成表查询达到备份的效果

   6. 刷新"数据表清单"列表框

   7. 删除"字段清单"列表框中的项目

四、字段操作相关代码

        1.添加字段

1. 1. 判断是否选择了要添加字段的数据表

   2. 指定新字段名称  

   3. 确认是否添加字段  

   4. 检查是否存在同名的数据表

   5. 添加字段 

   6. 刷新"字段清单"列表框

        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.确认按钮

1. 1.    检查数据表是否已经存在

   2.    创建数据表    

        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