| Option Explicit'一、窗體相關(guān)代碼'1.加載窗體時，建立數(shù)據(jù)庫連接，并刷新'數(shù)據(jù)庫'列表框的信息Private Sub UserForm_Initialize() '1.建立數(shù)據(jù)庫的連接 Call 數(shù)據(jù)庫連接 '2.調(diào)用自定義過程，為'數(shù)據(jù)庫表清單'列表框刷新數(shù)據(jù) Call 獲取數(shù)據(jù)表清單 End Sub'2.過程1：獲取數(shù)據(jù)表清單，用于列表框刷新數(shù)據(jù)Public Sub 獲取數(shù)據(jù)表清單() Set rs = cnn.OpenSchema(adSchemaTables) '獲取數(shù)據(jù)表的所有表名到記錄集中 With 數(shù)據(jù)表清單 '數(shù)據(jù)表清單為'數(shù)據(jù)表’列表框 .Clear Do Until rs.EOF '循環(huán)記錄集的所有記錄，找出表名稱 If rs!table_type = 'TABLE' Then .AddItem rs!table_name '將滿足條件的表名稱添加到列表中 End If rs.MoveNext Loop .ListStyle = fmListStyleOption '設(shè)置每個選項有單選按鈕 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 '查詢數(shù)據(jù)表，將字段名清單設(shè)置給'字段'列表框 sql = 'select * from ' & 數(shù)據(jù)表清單.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 '查詢選中的數(shù)據(jù)表 sql = 'select * from ' & 數(shù)據(jù)表清單.Text Set rs = New ADODB.Recordset rs.Open sql, cnn, adOpenKeyset, adLockOptimistic '將字段的名稱，類型，大小輸出到對應(yīng)的文本框中 字段名稱.Value = rs.Fields(字段清單.Text).name '字段名稱 字段類型.Value = IntToString(rs.Fields(字段清單.Text).Type) '通過自定義函數(shù)獲取字段類型名稱 字段大小.Value = rs.Fields(字段清單.Text).DefinedSize '字段大小 rs.Close Set rs = NothingEnd Sub'5.自定義函數(shù)，用于將數(shù)據(jù)類型整數(shù)值轉(zhuǎn)換為類型字符串Function IntToString(MyInt As Integer) As String Dim MyStr As String '定義類型字符串變量，用于存儲轉(zhuǎn)換后的類型字符串 ' 未更改完，感覺沒什么卵用，而且抄起來很煩 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 數(shù)據(jù)表維護(hù)End Sub'二、列表框和輸入框相關(guān)代碼'1.'數(shù)據(jù)表'列表框，單擊選擇時刷新所選表的字段列表Private Sub 數(shù)據(jù)表清單_Click() Call 獲取字段清單End Sub'2.'字段'列表框，單擊選擇時獲取字段信息Private Sub 字段清單_Click() Call 獲取字段信息End Sub'三、數(shù)據(jù)表相關(guān)操作代碼'1.創(chuàng)建數(shù)據(jù)表Private Sub 創(chuàng)建數(shù)據(jù)表_Click() 創(chuàng)建數(shù)據(jù)表窗體.Show Call 獲取數(shù)據(jù)表清單End Sub'2.移除數(shù)據(jù)表Private Sub 移除數(shù)據(jù)表_Click() Dim sql As String '判斷是否選擇了要刪除的數(shù)據(jù)表 If 數(shù)據(jù)表清單.ListIndex = -1 Then MsgBox '沒有選擇要刪除的數(shù)據(jù)表！', vbCritical, '警告' Exit Sub End If '確認(rèn)是否刪除選擇的數(shù)據(jù)表 If MsgBox('是否刪除數(shù)據(jù)表? ', vbQuestion + vbYesNo) = vbNo _ Then Exit Sub '刪除選定的數(shù)據(jù)表 sql = 'drop table ' & 數(shù)據(jù)表清單.Text cnn.Execute sql MsgBox '數(shù)據(jù)庫 & 數(shù)據(jù)表清單.Text & '>被成功刪除！', vbInformation + vbOKOnly, '刪除數(shù)據(jù)表' '刷新'數(shù)據(jù)表清單'列表框 Call 獲取數(shù)據(jù)表清單 '刪除'字段清單'列表框中的項目 字段清單.ClearEnd Sub'3.重命名數(shù)據(jù)表Private Sub 重命名數(shù)據(jù)表_Click() Dim sql As String, mynewname As String '判斷是否選擇了要重命名的數(shù)據(jù)表 If 數(shù)據(jù)表清單.ListIndex = -1 Then MsgBox '沒有選要重命名的數(shù)據(jù)表！', vbCritical, '警告' Exit Sub End If '確認(rèn)是否重命名選擇的數(shù)據(jù)表 If MsgBox('是否重命名數(shù)據(jù)表? ', vbQuestion + vbYesNo) = vbNo _ Then Exit Sub restart: '指定數(shù)據(jù)表的新名稱 mynewname = InputBox('請輸入數(shù)據(jù)表新名稱：', '輸入數(shù)據(jù)表名稱') If Len(Trim(mynewname)) = 0 Then 'trim函數(shù)可以去除空格 MsgBox '沒有輸入有效的數(shù)據(jù)表名稱！', vbCritical, '警告' Exit Sub End If '檢查是否存在同名的數(shù)據(jù)表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox '數(shù)據(jù)表 & mynewname & '>已經(jīng)存在，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '查詢原數(shù)據(jù)表，生成新表名，刪除原表達(dá)到重命名的效果 sql = 'select * into ' & mynewname & ' from ' & 數(shù)據(jù)表清單.Text cnn.Execute sql sql = 'drop table ' & 數(shù)據(jù)表清單.Text cnn.Execute sql MsgBox '成功將數(shù)據(jù)表名稱改為 mynewname & '>', vbInformation + vbOKOnly, '數(shù)據(jù)表重命名' '刷新'數(shù)據(jù)表清單'列表框 Call 獲取數(shù)據(jù)表清單 '刪除'字段清單'列表框中的項目 字段清單.Clear Set rs = NothingEnd Sub'4.備份數(shù)據(jù)表Private Sub 備份數(shù)據(jù)表_Click() Dim sql As String, mynewname As String '判斷是否選擇了要備份的數(shù)據(jù)表 If 數(shù)據(jù)表清單.ListIndex = -1 Then MsgBox '沒有選則要備份的數(shù)據(jù)表！', vbCritical, '警告' Exit Sub End If '確認(rèn)是否備份選擇的數(shù)據(jù)表 If MsgBox('是否備份數(shù)據(jù)表 & 數(shù)據(jù)表清單.Text & '>? ', vbQuestion + vbYesNo) = vbNo _ Then Exit Sub restart: '指定數(shù)據(jù)表的新名稱 mynewname = InputBox('請輸入數(shù)據(jù)表新名稱：', '輸入數(shù)據(jù)表名稱') If Len(Trim(mynewname)) = 0 Then 'trim函數(shù)可以去除空格 MsgBox '沒有輸入有效的數(shù)據(jù)表名稱！', vbCritical, '警告' Exit Sub End If '檢查是否存在同名的數(shù)據(jù)表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox '數(shù)據(jù)表已經(jīng)存在，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '利用生成表查詢達(dá)到備份的效果 sql = 'select * into ' & mynewname & ' from ' & 數(shù)據(jù)表清單.Text cnn.Execute sql MsgBox '成功將數(shù)據(jù)表 & 數(shù)據(jù)表清單.Text & '>備份，名稱為 & _ mynewname & '>', vbInformation + vbOKOnly, '備份數(shù)據(jù)表' '刷新'數(shù)據(jù)表清單'列表框 Call 獲取數(shù)據(jù)表清單 '刪除'字段清單'列表框中的項目 字段清單.Clear Set rs = Nothing End Sub'四、字段操作相關(guān)代碼'1.添加字段Private Sub 添加字段_Click() Dim sql As String, mynewfield As String '判斷是否選擇了要添加字段的數(shù)據(jù)表 If 數(shù)據(jù)表清單.ListIndex = -1 Then MsgBox '沒有選要添加字段的數(shù)據(jù)表！', vbCritical, '警告' Exit Sub End If restart: '指定新字段名稱 mynewfield = InputBox('請輸入新字段名稱：', '輸入新字段') If Len(Trim(mynewfield)) = 0 Then 'trim函數(shù)可以去除空格 MsgBox '沒有輸入有效的字段名！', vbCritical, '警告' Exit Sub End If '確認(rèn)是否添加字段 If MsgBox('是否向數(shù)據(jù)表 & 數(shù)據(jù)表清單.Text & '>中添加字段 _ & mynewfield & '>? ', vbQuestion + vbYesNo) = vbNo _ Then Exit Sub '檢查是否存在同名的數(shù)據(jù)表 Set rs = cnn.OpenSchema(adSchemaColumns) Do Until rs.EOF If LCase(rs!column_name) = LCase(mynewfield) Then MsgBox '數(shù)據(jù)表中已經(jīng)存在字段 & mynewfield & '>，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '添加字段 sql = 'alter table ' & 數(shù)據(jù)表清單.Text & ' add ' & mynewfield & ' text(50)' cnn.Execute sql MsgBox '數(shù)據(jù)表 & 數(shù)據(jù)表清單.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 |
|
|
