【每日任務(wù)管理系統(tǒng)】(1) VB 管理系統(tǒng) 代碼分享 Visual Basic 編程 程序 Access數(shù)據(jù)
前端程序
前端程序開發(fā)平臺為VB6.0，編程語言為Visual Basic
窗體
系統(tǒng)登錄
Private Sub Command登錄_Click()
Dim 賬號text As String? '定義變量存儲賬號
Dim 密碼text As String? '定義變量存儲密碼
If Trim(Me.Text賬號) <> "" Then? '輸入賬號不能為空
賬號text = Me.Text賬號? '存儲錄入賬號到變量中（可拓展更多判斷，如字符長度等）
Else
MsgBox "賬號不能為空！"
Exit Sub
End If
If Trim(Me.Text密碼) <> "" Then? '輸入密碼不能為空
? ? If Len(Trim(Me.Text密碼)) < 6 Then
? ? ? ? MsgBox "密碼長度不能小于6位！"
? ? ? ? Exit Sub
? ? End If
密碼text = Me.Text密碼? '存儲錄入密碼到變量中（可拓展更多判斷，如字符長度等）
Else
MsgBox "密碼不能為空！"
Exit Sub
End If
'-賬號密碼驗證
Dim login_conn As New ADODB.Connection? '連接到ACCESS數(shù)據(jù)庫
With login_conn? ? ? ? ?'mdb格式連接
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
Dim login_rs As New ADODB.Recordset
Dim login_sql As String
login_sql = "select * from 賬號表 where 賬號= '" & Me.Text賬號 & "' and 密碼='" & Me.Text密碼 & "'"? ? ?'查詢用戶表
login_rs.Open login_sql, login_conn, adOpenDynamic, adLockOptimistic
If login_rs.EOF = False Then '循環(huán)表的內(nèi)容
'--
On Error Resume Next
login_name = login_rs.Fields("賬號").Value? ? ? '賬號密碼賦值到公共變量之后使用
login_pw = login_rs.Fields("密碼").Value
user_name = login_rs.Fields("姓名").Value
user_role = login_rs.Fields("角色").Value
全部任務(wù)權(quán)限 = login_rs.Fields("全部任務(wù)").Value
任務(wù)查看權(quán)限 = login_rs.Fields("任務(wù)查看").Value
任務(wù)添加權(quán)限 = login_rs.Fields("任務(wù)添加").Value
任務(wù)更新權(quán)限 = login_rs.Fields("任務(wù)更新").Value
任務(wù)刪除權(quán)限 = login_rs.Fields("任務(wù)刪除").Value
常見任務(wù)管理權(quán)限 = login_rs.Fields("常見任務(wù)管理").Value
負責(zé)人管理權(quán)限 = login_rs.Fields("負責(zé)人管理").Value
任務(wù)類型管理權(quán)限 = login_rs.Fields("任務(wù)類型管理").Value
任務(wù)狀態(tài)管理權(quán)限 = login_rs.Fields("任務(wù)狀態(tài)管理").Value
MsgBox "登錄成功", , "提示"
Unload Me? '關(guān)閉登錄窗體
frm系統(tǒng)主頁.Show
Else
MsgBox "賬號或密碼錯誤，請重新登錄"
login_count = login_count + 1? ?'登錄錯誤3次，退出
? ? If login_count = 3 Then
? ? ? ? MsgBox "賬號或密碼錯誤達3次"
? ? ? ? Unload Me
? ? End If
End If
login_rs.Close
Set login_rs = Nothing
login_conn.Close
Set login_conn = Nothing
Exit Sub
登錄失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command退出_Click()
Unload Me
End Sub
Private Sub Command用戶注冊_Click()
frm用戶注冊.Show 1
End Sub
系統(tǒng)主頁
Private Sub cjrw_Click(Index As Integer)
If 常見任務(wù)管理權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm常見任務(wù).Show 1
End Sub
Private Sub fhdl_Click()
Unload Me
frm系統(tǒng)登錄.Show
login_name = ""
login_pw = ""
user_name = ""
user_role = ""
全部任務(wù)權(quán)限 = False
任務(wù)查看權(quán)限 = False
任務(wù)添加權(quán)限 = False
任務(wù)更新權(quán)限 = False
任務(wù)刪除權(quán)限 = False
常見任務(wù)管理權(quán)限 = False
負責(zé)人管理權(quán)限 = False
任務(wù)類型管理權(quán)限 = False
任務(wù)狀態(tài)管理權(quán)限 = False
End Sub
Private Sub Form_Load()
StatusBar1.Panels(2).Text = login_name
StatusBar1.Panels(3).Text = user_name
StatusBar1.Panels(4).Text = user_role
Label日期.Caption = Date
'當前登錄用戶添加的任務(wù)
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = "Select * From 今日任務(wù)查詢 where " & "創(chuàng)建賬號 ='" & login_name & "'"
Adodc1.Refresh? ? '刷新
End Sub
Private Sub fzr_Click(Index As Integer)
If 負責(zé)人管理權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm負責(zé)人.Show 1
End Sub
Private Sub grxx_Click()
frm個人信息.Show 1
End Sub
Private Sub qbrw_Click(Index As Integer)
If 全部任務(wù)權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm全部任務(wù).Show 1
End Sub
Private Sub rwcx_Click(Index As Integer)
If 任務(wù)查看權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)查詢.Show 1
End Sub
Private Sub rwlx_Click(Index As Integer)
If 任務(wù)類型管理權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)類型.Show 1
End Sub
Private Sub rwtj_Click(Index As Integer)
If 任務(wù)添加權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)添加.Show 1
End Sub
Private Sub rwzt_Click(Index As Integer)
If 任務(wù)狀態(tài)管理權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)狀態(tài).Show 1
End Sub
Private Sub tcxt_Click()
Unload Me
End Sub
Private Sub xgmm_Click()
frm修改密碼.Show 1
End Sub
常見任務(wù)
Option Explicit
Public frm_title As String? '存儲窗體標題
Public frm_datatype As Integer? '存儲當前管理狀態(tài)（添加，修改，查詢）
Public key_data As String? ?'存儲修改主鍵
Dim search_filter As String '存儲篩選條件
Dim search_order As String? '存儲排序條件
Private Sub Command保存_Click()
On Error GoTo 保存失敗錯誤
'========================================================================為添加狀態(tài)時
If frm_datatype = 1 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'滿足條件添加記錄
'----------------------------------
Dim add_conn As New ADODB.Connection? ? '連接數(shù)據(jù)
Dim add_rs As New ADODB.Recordset
With add_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
? ? ? ?add_rs.Open "常見任務(wù)表", add_conn, adOpenKeyset, adLockOptimistic? ?'連接表生成記錄集
? ? ? ?add_rs.AddNew? ? '添加記錄
? ? ? ?On Error Resume Next
? ? ? ?add_rs!任務(wù)名稱 = Text1(0).Text? '新記錄賦值
? ? ? ?add_rs.Update? ? '更新
? ? ? ?add_rs.Close '關(guān)閉清空記錄集和連接
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "添加完成"
? ? ? ?Text1(0).Text = ""
? ? ? ?Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
? ? ? ?DataGrid1.Refresh
? ? ? ?Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點繼續(xù)錄入
'----------------------------------
Else
MsgBox "任務(wù)名稱不能為空"
Exit Sub
End If
End If
'========================================================================為修改狀態(tài)時
If frm_datatype = 2 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'判斷主鍵不能重復(fù)
? ? ? ? If key_data <> Text1(0).Text Then? ?'主鍵修改，判斷主鍵是否重復(fù)
? ? ? ? If dcountlink("任務(wù)名稱", "常見任務(wù)表", "任務(wù)名稱='" & Text1(0) & "'", 0) > 0 Then
? ? ? ? MsgBox "該任務(wù)名稱已存在，請修改后重試"
? ? ? ? Exit Sub
? ? ? ? End If
? ? ? ? End If
'滿足條件添加記錄
'----------------------------------
'連接數(shù)據(jù)庫并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
Dim update_sql As String
update_sql = "Select * From 常見任務(wù)表 Where 任務(wù)名稱='" & key_data & "'"
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
'--字段更新
On Error Resume Next
With update_rs
? ? ? !任務(wù)名稱 = Text1(0).Text? '新記錄賦值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) '主鍵賦值
MsgBox "更新完成！"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點
'----------------------------------
Else
MsgBox "任務(wù)名稱不能為空"
Exit Sub
End If
End If
Exit Sub
保存失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i? ?'清空控件中的數(shù)據(jù)
For i = 1 To Text1.Count
Text1(i - 1).Text = ""
Next i
'點擊取消時顯示全部記錄，清空條件
search_filter = ""
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command刪除_Click()
On Error GoTo 刪除失敗錯誤
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox("是否刪除任務(wù)名稱為【" & del_data & "】 的記錄？", vbYesNo, "提示") <> vbYes Then? ?'刪除前提醒
Exit Sub
End If
'執(zhí)行刪除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = "delete from 常見任務(wù)表 Where 任務(wù)名稱='" & del_data & "'"? ? '定義刪除sql語句
With del_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
? .Execute del_sql? '執(zhí)行刪除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox "刪除成功"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Exit Sub
刪除失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件取消鎖定可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus? ?'第一個控件獲得焦點
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then? ?'判斷是否為修改狀態(tài)
MsgBox "需要修改數(shù)據(jù)，請先進入修改狀態(tài)"
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound? ?'獲取選擇記錄的數(shù)據(jù)
? ? ? ? Text1(i).Text = DataGrid1.Columns(i).Text
Next i
? ? '解除鎖定（數(shù)據(jù)可編輯）
For i = 0 To Text1.UBound
? ? Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text? ? '主鍵賦值
End Sub
Private Sub Form_Load()? ? ? ?'窗體加載
frm_title = "常見任務(wù)管理"? '賦值標題到變量
frm_datatype = 5? ? ? '設(shè)置窗體當前管理數(shù)據(jù)類型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件鎖定不可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = True
Next i
Adodc1.Refresh? ? '刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer)? ? '文本框獲得焦點，背景色修改，選中原有文本
? Text1(Index).BackColor = &HFFFF00
? Text1(Index).SelStart = 0
? Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer)? ?'文本框失去焦點設(shè)計填充顏色（恢復(fù)）
? Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer)? ?'根據(jù)狀態(tài)顯示不同標題，設(shè)置按鈕狀態(tài)
Select Case frmdatatype
Case 1? '添加
Me.Caption = frm_title & "（添加）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 2? '添加
Me.Caption = frm_title & "（修改）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 3? '刪除
Me.Caption = frm_title
Case 5? '取消
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = True
key_data = 0
'鎖定所有控件
Dim i
For i = 0 To Text1.UBound
? ? Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command刪除.Enabled = False
End Select
End Sub
常見任務(wù)選擇
Private Sub Command查詢_Click()
If Text(0).Text <> "" Then
Adodc1.RecordSource = "Select * From 常見任務(wù)表 where 任務(wù)名稱 like '%" & Text(0).Text & "%'"
Else
Adodc1.RecordSource = "Select * From 常見任務(wù)表"
End If
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
Adodc1.RecordSource = "Select * From 常見任務(wù)表"
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command選擇_Click()
On Error Resume Next
Dim i
For i = 0 To Forms.Count - 1
? ? If Forms(i).Name = rw_formname Then
? ? ? ? Forms(i).Text(0) = DataGrid1.Columns(0).Text
? ? End If
Next i
Unload Me
End Sub
Private Sub Form_Load()
Adodc1.CommandType = adCmdUnknown
End Sub
負責(zé)人
Public frm_title As String? '存儲窗體標題
Public frm_datatype As Integer? '存儲當前管理狀態(tài)（添加，修改，查詢）
Public key_data As String? ?'存儲修改主鍵
Dim search_filter As String '存儲篩選條件
Dim search_order As String? '存儲排序條件
Private Sub Command保存_Click()
On Error GoTo 保存失敗錯誤
'==為添加狀態(tài)時
If frm_datatype = 1 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'滿足條件添加記錄
'----------------------------------
Dim add_conn As New ADODB.Connection? ? '連接數(shù)據(jù)
Dim add_rs As New ADODB.Recordset
With add_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
? ? ? ?add_rs.Open "負責(zé)人表", add_conn, adOpenKeyset, adLockOptimistic? ?'連接表生成記錄集
? ? ? ?add_rs.AddNew? ? '添加記錄
? ? ? ?On Error Resume Next
? ? ? ?add_rs!負責(zé)人 = Text1(0).Text? '新記錄賦值
? ? ? ?add_rs.Update? ? '更新
? ? ? ?add_rs.Close '關(guān)閉清空記錄集和連接
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "添加完成"
? ? ? ?Text1(0).Text = ""
? ? ? ?Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
? ? ? ?DataGrid1.Refresh
? ? ? ?Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點繼續(xù)錄入
'----------------------------------
Else
MsgBox "負責(zé)人不能為空"
Exit Sub
End If
End If
'========================================================================為修改狀態(tài)時
If frm_datatype = 2 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'判斷主鍵不能重復(fù)
? ? ? ? If key_data <> Text1(0).Text Then? ?'主鍵修改，判斷主鍵是否重復(fù)
? ? ? ? If dcountlink("負責(zé)人", "負責(zé)人表", "負責(zé)人='" & Text1(0) & "'", 0) > 0 Then
? ? ? ? MsgBox "該負責(zé)人已存在，請修改后重試"
? ? ? ? Exit Sub
? ? ? ? End If
? ? ? ? End If
'滿足條件添加記錄
'----------------------------------
'連接數(shù)據(jù)庫并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
Dim update_sql As String
update_sql = "Select * From 負責(zé)人表 Where 負責(zé)人='" & key_data & "'"
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
'--字段更新
On Error Resume Next
With update_rs
? ? ? !負責(zé)人 = Text1(0).Text? '新記錄賦值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) '主鍵賦值
MsgBox "更新完成！"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點
'----------------------------------
Else
MsgBox "負責(zé)人不能為空"
Exit Sub
End If
End If
Exit Sub
保存失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i? ?'清空控件中的數(shù)據(jù)
For i = 1 To Text1.Count
Text1(i - 1).Text = ""
Next i
'點擊取消時顯示全部記錄，清空條件
search_filter = ""
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command刪除_Click()
On Error GoTo 刪除失敗錯誤
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox("是否刪除負責(zé)人為【" & del_data & "】 的記錄？", vbYesNo, "提示") <> vbYes Then? ?'刪除前提醒
Exit Sub
End If
'執(zhí)行刪除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = "delete from 負責(zé)人表 Where 負責(zé)人='" & del_data & "'"? ? '定義刪除sql語句
With del_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
? .Execute del_sql? '執(zhí)行刪除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox "刪除成功"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Exit Sub
刪除失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件取消鎖定可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus? ?'第一個控件獲得焦點
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then? ?'判斷是否為修改狀態(tài)
MsgBox "需要修改數(shù)據(jù)，請先進入修改狀態(tài)"
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound? ?'獲取選擇記錄的數(shù)據(jù)
? ? ? ? Text1(i).Text = DataGrid1.Columns(i).Text
Next i
? ? '解除鎖定（數(shù)據(jù)可編輯）
For i = 0 To Text1.UBound
? ? Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text? ? '主鍵賦值
End Sub
Private Sub Form_Load()? ? ? ?'窗體加載
frm_title = "負責(zé)人管理"? '賦值標題到變量
frm_datatype = 5? ? ? '設(shè)置窗體當前管理數(shù)據(jù)類型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件鎖定不可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = True
Next i
Adodc1.Refresh? ? '刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer)? ? '文本框獲得焦點，背景色修改，選中原有文本
? Text1(Index).BackColor = &HFFFF00
? Text1(Index).SelStart = 0
? Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer)? ?'文本框失去焦點設(shè)計填充顏色（恢復(fù)）
? Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer)? ?'根據(jù)狀態(tài)顯示不同標題，設(shè)置按鈕狀態(tài)
Select Case frmdatatype
Case 1? '添加
Me.Caption = frm_title & "（添加）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 2? '添加
Me.Caption = frm_title & "（修改）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 3? '刪除
Me.Caption = frm_title
Case 5? '取消
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = True
key_data = 0
'鎖定所有控件
Dim i
For i = 0 To Text1.UBound
? ? Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command刪除.Enabled = False
End Select
End Sub
個人信息
Private Sub Command保存_Click()
If Me.Text1(2).Text <> "" Then
? ? If Me.Text1(2).Text <> "男" And Me.Text1(2).Text <> "女" Then
? ? ? ?MsgBox "性別只能輸入男或女"
? ? ? ?Exit Sub
? ? End If
End If
If MsgBox("是否更新個人信息？", vbYesNo, "提示") = vbYes Then
Me.Adodc1.Recordset.Update
MsgBox "更新完成"
End If
End Sub
Private Sub Form_Load()
? ?Me.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
? ?Me.Adodc1.CommandType = adCmdUnknown
? ?Me.Adodc1.RecordSource = "select * From 賬號表 Where 賬號='" & login_name & "'"
? ?Me.Adodc1.Refresh? ? '刷新
? ?'顯示權(quán)限
? ??
Check全部任務(wù).Value = CInt(Adodc1.Recordset.Fields("全部任務(wù)").Value) * -1
Check任務(wù)查看.Value = CInt(Adodc1.Recordset.Fields("任務(wù)查看").Value) * -1
Check任務(wù)添加.Value = CInt(Adodc1.Recordset.Fields("任務(wù)添加").Value) * -1
Check任務(wù)更新.Value = CInt(Adodc1.Recordset.Fields("任務(wù)更新").Value) * -1
Check任務(wù)刪除.Value = CInt(Adodc1.Recordset.Fields("任務(wù)刪除").Value) * -1
Check常見任務(wù)管理.Value = CInt(Adodc1.Recordset.Fields("常見任務(wù)管理").Value) * -1
Check負責(zé)人管理.Value = CInt(Adodc1.Recordset.Fields("負責(zé)人管理").Value) * -1
Check任務(wù)類型管理.Value = CInt(Adodc1.Recordset.Fields("任務(wù)類型管理").Value) * -1
Check任務(wù)狀態(tài)管理.Value = CInt(Adodc1.Recordset.Fields("任務(wù)狀態(tài)管理").Value) * -1
End Sub
修改密碼
Private Sub Command修改密碼_Click()
On Error GoTo 操作失敗錯誤
Dim lname As String
Dim opw As String
Dim npw As String
If Trim(Me.Text賬號) <> "" Then '判斷賬號不能為空
? ? lname = Trim(Me.Text賬號)
Else
? ? MsgBox "賬號不能為空"
? ? Exit Sub
End If
If Trim(Me.Textoldpw) <> "" Then '判斷舊密碼不能為空
? ? opw = Trim(Me.Textoldpw)
Else
? ? MsgBox "原密碼不能為空"
? ? Exit Sub
End If
If Trim(Me.Textnewpw) <> "" Then '判斷新密碼不能為空
? ? npw = Trim(Me.Textnewpw)
Else
? ? MsgBox "新密碼不能為空"
? ? Exit Sub
End If
If opw <> login_pw Then? ? ? '判斷原密碼是否正確
? ? MsgBox "原密碼不正確"
? ? Exit Sub
End If
If Len(Trim(Me.Textnewpw)) < 6 Then '判斷密碼長度不能小于6
? ? MsgBox "密碼長度不能小于6位！"
? ? Exit Sub
End If
If opw = npw Then? ? '新舊密碼不能相同
? ? MsgBox "新密碼不能與原密碼相同"
? ? Exit Sub
End If
'修改密碼操作
Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
With Cnn? ? ? ? 'mdb格式連接
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
Dim rs_sql As String
rs_sql = "select * from 賬號表 where 賬號='" & login_name & "'"? ? ?'查詢該賬號記錄
rs.Open rs_sql, Cnn, adOpenDynamic, adLockOptimistic
If rs.EOF = False Then '循環(huán)表的內(nèi)容
? ? rs.Fields("密碼") = npw
? ? rs.Update
? ? login_pw = npw
? ? MsgBox "修改密碼完成"
Else
? ? MsgBox "未找到該賬號"
? ? Exit Sub
End If
rs.Close
Set rs = Nothing
Cnn.Close
Set Cnn = Nothing
Exit Sub
操作失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Me.Text賬號 = login_name? ? '顯示賬號
End Sub
用戶注冊
Private Sub Command注冊_Click()
On Error GoTo 錯誤提示
If Text1(0) = "" Or IsNull(Text1(0)) = True Then
MsgBox "賬號值不能為空！"
Exit Sub
Else
? ? If Len(Text1(0)) > 15 Then
? ? ? ? MsgBox "賬號不能超過15個字符！"
? ? ? ? Exit Sub
? ? End If
End If
If Text1(1) = "" Or IsNull(Text1(1)) = True Then
MsgBox "姓名值不能為空！"
Exit Sub
Else
? ? If Len(Text1(1)) > 30 Then
? ? ? ? MsgBox "姓名不能超過30個字符！"
? ? ? ? Exit Sub
? ? End If
End If
If Text1(2) = "" Or IsNull(Text1(2)) = True Then
MsgBox "性別值不能為空！"
Exit Sub
Else
End If
If Text1(3) = "" Or IsNull(Text1(3)) = True Then
MsgBox "聯(lián)系方式不能為空！"
Exit Sub
Else
? ? If Len(Text1(3)) > 30 Then
? ? ? ? MsgBox "聯(lián)系方式不能超過30個字符！"
? ? ? ? Exit Sub
? ? End If
End If
If Text1(4) = "" Or IsNull(Text1(4)) = True Then
MsgBox "角色不能為空！"
Exit Sub
Else
End If
If Text1(5) = "" Or IsNull(Text1(5)) = True Then
MsgBox "密碼不能為空！"
Exit Sub
Else
? ? If Len(Text1(5)) > 15 Then
? ? ? ? MsgBox "密碼不能超過15個字符！"
? ? ? ? Exit Sub
? ? End If
End If
If Text1(6) = "" Or IsNull(Text1(6)) = True Then
MsgBox "確認密碼不能為空！"
Exit Sub
Else
End If
If Text1(5).Text <> Text1(6).Text Then
MsgBox "密碼和確認密碼不一致！"
Exit Sub
End If
'檢查賬號是否已存在
? ? If dcountlink("賬號", "賬號表", "賬號='" & Text1(1) & "'", 0) > 0 Then
? ? MsgBox "該賬號已存在，請修改后重試"
? ? Exit Sub
? ? End If
Dim add_conn As New ADODB.Connection
Dim add_rs As New ADODB.Recordset
With add_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
? ? ? ?add_rs.Open "賬號表", add_conn, adOpenKeyset, adLockOptimistic
? ? ? ?add_rs.AddNew
? ? ? ?On Error Resume Next
? ? ? ? ? ? add_rs!賬號.Value = Text1(0).Text
? ? ? ? ? ? add_rs!姓名.Value = Text1(1).Text
? ? ? ? ? ? add_rs!性別.Value = Text1(2).Text
? ? ? ? ? ? add_rs!聯(lián)系方式.Value = Text1(3).Text
? ? ? ? ? ? add_rs!角色.Value = Text1(4).Text
? ? ? ? ? ? add_rs!密碼.Value = Text1(5).Text
? ? ? ? ? ? add_rs!全部任務(wù).Value = False
? ? ? ? ? ? add_rs!任務(wù)查看.Value = True
? ? ? ? ? ? add_rs!任務(wù)添加.Value = True
? ? ? ? ? ? add_rs!任務(wù)更新.Value = True
? ? ? ? ? ? add_rs!任務(wù)刪除.Value = True
? ? ? ? ? ? add_rs!常見任務(wù)管理.Value = False
? ? ? ? ? ? add_rs!負責(zé)人管理.Value = False
? ? ? ? ? ? add_rs!任務(wù)類型管理.Value = False
? ? ? ? ? ? add_rs!任務(wù)狀態(tài)管理.Value = False
? ? ? ? ? ??
? ? ? ?add_rs.Update
? ? ? ?add_rs.Close
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "注冊完成"
? ? ? ?Unload Me
Exit Sub
錯誤提示:
MsgBox Err.Description
End Sub
Private Sub Text1_DblClick(Index As Integer)
If Index = 2 Then
? ?If Text1(2).Text = "男" Then
? ?Text1(2).Text = "女"
? ?Else
? ?Text1(2).Text = "男"
? ?End If
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
If Text1(2).Text <> "男" And Text1(2).Text <> "女" Then
MsgBox "性別只能輸入男或女"
Text1(2).Text = "男"
End If
End Sub
任務(wù)類型
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件取消鎖定可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus? ?'第一個控件獲得焦點
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then? ?'判斷是否為修改狀態(tài)
MsgBox "需要修改數(shù)據(jù)，請先進入修改狀態(tài)"
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound? ?'獲取選擇記錄的數(shù)據(jù)
? ? ? ? Text1(i).Text = DataGrid1.Columns(i).Text
Next i
? ? '解除鎖定（數(shù)據(jù)可編輯）
For i = 0 To Text1.UBound
? ? Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text? ? '主鍵賦值
End Sub
Private Sub Form_Load()? ? ? ?'窗體加載
frm_title = "任務(wù)類型管理"? '賦值標題到變量
frm_datatype = 5? ? ? '設(shè)置窗體當前管理數(shù)據(jù)類型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件鎖定不可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = True
Next i
Adodc1.Refresh? ? '刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer)? ? '文本框獲得焦點，背景色修改，選中原有文本
? Text1(Index).BackColor = &HFFFF00
? Text1(Index).SelStart = 0
? Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer)? ?'文本框失去焦點設(shè)計填充顏色（恢復(fù)）
? Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer)? ?'根據(jù)狀態(tài)顯示不同標題，設(shè)置按鈕狀態(tài)
Select Case frmdatatype
Case 1? '添加
Me.Caption = frm_title & "（添加）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 2? '添加
Me.Caption = frm_title & "（修改）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 3? '刪除
Me.Caption = frm_title
Case 5? '取消
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = True
key_data = 0
'鎖定所有控件
Dim i
For i = 0 To Text1.UBound
? ? Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command刪除.Enabled = False
End Select
End Sub
任務(wù)狀態(tài)
Public frm_title As String? '存儲窗體標題
Public frm_datatype As Integer? '存儲當前管理狀態(tài)（添加，修改，查詢）
Public key_data As String? ?'存儲修改主鍵
Dim search_filter As String '存儲篩選條件
Dim search_order As String? '存儲排序條件
Private Sub Command保存_Click()
On Error GoTo 保存失敗錯誤
'========================================================================為添加狀態(tài)時
If frm_datatype = 1 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'滿足條件添加記錄
'----------------------------------
Dim add_conn As New ADODB.Connection? ? '連接數(shù)據(jù)
Dim add_rs As New ADODB.Recordset
With add_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
? ? ? ?add_rs.Open "任務(wù)狀態(tài)表", add_conn, adOpenKeyset, adLockOptimistic? ?'連接表生成記錄集
? ? ? ?add_rs.AddNew? ? '添加記錄
? ? ? ?On Error Resume Next
? ? ? ?add_rs!任務(wù)狀態(tài) = Text1(0).Text? '新記錄賦值
? ? ? ?add_rs.Update? ? '更新
? ? ? ?add_rs.Close '關(guān)閉清空記錄集和連接
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "添加完成"
? ? ? ?Text1(0).Text = ""
? ? ? ?Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
? ? ? ?DataGrid1.Refresh
? ? ? ?Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點繼續(xù)錄入
'----------------------------------
Else
MsgBox "任務(wù)狀態(tài)不能為空"
Exit Sub
End If
End If
'========================================================================為修改狀態(tài)時
If frm_datatype = 2 Then
'判斷數(shù)據(jù)不能為空
If Text1(0).Text <> "" Then
'判斷主鍵不能重復(fù)
? ? ? ? If key_data <> Text1(0).Text Then? ?'主鍵修改，判斷主鍵是否重復(fù)
? ? ? ? If dcountlink("任務(wù)狀態(tài)", "任務(wù)狀態(tài)表", "任務(wù)狀態(tài)='" & Text1(0) & "'", 0) > 0 Then
? ? ? ? MsgBox "該任務(wù)狀態(tài)已存在，請修改后重試"
? ? ? ? Exit Sub
? ? ? ? End If
? ? ? ? End If
'滿足條件添加記錄
'----------------------------------
'連接數(shù)據(jù)庫并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
Dim update_sql As String
update_sql = "Select * From 任務(wù)狀態(tài)表 Where 任務(wù)狀態(tài)='" & key_data & "'"
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
'--字段更新
On Error Resume Next
With update_rs
? ? ? !任務(wù)狀態(tài) = Text1(0).Text? '新記錄賦值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) '主鍵賦值
MsgBox "更新完成！"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Text1(0).SetFocus? ? '第一個錄入數(shù)據(jù)控件獲得焦點
'----------------------------------
Else
MsgBox "任務(wù)狀態(tài)不能為空"
Exit Sub
End If
End If
Exit Sub
保存失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i? ?'清空控件中的數(shù)據(jù)
For i = 1 To Text1.Count
Text1(i - 1).Text = ""
Next i
'點擊取消時顯示全部記錄，清空條件
search_filter = ""
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command刪除_Click()
On Error GoTo 刪除失敗錯誤
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox("是否刪除任務(wù)狀態(tài)為【" & del_data & "】 的記錄？", vbYesNo, "提示") <> vbYes Then? ?'刪除前提醒
Exit Sub
End If
'執(zhí)行刪除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = "delete from 任務(wù)狀態(tài)表 Where 任務(wù)狀態(tài)='" & del_data & "'"? ? '定義刪除sql語句
With del_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
? .Execute del_sql? '執(zhí)行刪除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox "刪除成功"
Adodc1.Refresh? ? ? ?'刷新顯示結(jié)果
DataGrid1.Refresh
Exit Sub
刪除失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件取消鎖定可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus? ?'第一個控件獲得焦點
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then? ?'判斷是否為修改狀態(tài)
MsgBox "需要修改數(shù)據(jù)，請先進入修改狀態(tài)"
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound? ?'獲取選擇記錄的數(shù)據(jù)
? ? ? ? Text1(i).Text = DataGrid1.Columns(i).Text
Next i
? ? '解除鎖定（數(shù)據(jù)可編輯）
For i = 0 To Text1.UBound
? ? Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text? ? '主鍵賦值
End Sub
Private Sub Form_Load()? ? ? ?'窗體加載
frm_title = "任務(wù)狀態(tài)管理"? '賦值標題到變量
frm_datatype = 5? ? ? '設(shè)置窗體當前管理數(shù)據(jù)類型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count? ? '控件鎖定不可錄入數(shù)據(jù)
Text1(i - 1).Text = ""
Text1(i - 1).Locked = True
Next i
Adodc1.Refresh? ? '刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer)? ? '文本框獲得焦點，背景色修改，選中原有文本
? Text1(Index).BackColor = &HFFFF00
? Text1(Index).SelStart = 0
? Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer)? ?'文本框失去焦點設(shè)計填充顏色（恢復(fù)）
? Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer)? ?'根據(jù)狀態(tài)顯示不同標題，設(shè)置按鈕狀態(tài)
Select Case frmdatatype
Case 1? '添加
Me.Caption = frm_title & "（添加）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 2? '添加
Me.Caption = frm_title & "（修改）"
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = False
Case 3? '刪除
Me.Caption = frm_title
Case 5? '取消
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command刪除.Enabled = True
key_data = 0
'鎖定所有控件
Dim i
For i = 0 To Text1.UBound
? ? Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
'按鈕狀態(tài)設(shè)置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command刪除.Enabled = False
End Select
End Sub
模塊
公共變量
Public login_name As String '賬號
Public login_pw As String '密碼
Public user_name As String '姓名
Public user_role As String? ? ?'角色
'權(quán)限
Public 全部任務(wù)權(quán)限 As Boolean
Public 任務(wù)查看權(quán)限 As Boolean
Public 任務(wù)添加權(quán)限 As Boolean
Public 任務(wù)更新權(quán)限 As Boolean
Public 任務(wù)刪除權(quán)限 As Boolean
Public 常見任務(wù)管理權(quán)限 As Boolean
Public 負責(zé)人管理權(quán)限 As Boolean
Public 任務(wù)類型管理權(quán)限 As Boolean
Public 任務(wù)狀態(tài)管理權(quán)限 As Boolean
'-------------------------------------------
'任務(wù)
Public rw_filter As String? '篩選
Public rw_order As String? '排序
Public rw_num As Long? '主鍵
Public rw_formname As String? ? '任務(wù)選擇
公共函數(shù)過程
Public Function dlookuplink(ByVal rsfieldname As String, ByVal rstable As String, ByVal rscondition As String, ByVal nullvalue) As String? ?'查詢指定記錄返回值
Dim dlookuplink_conn As New ADODB.Connection
Dim dlookuplink_rs As New ADODB.Recordset
dlookuplink = nullvalue
On Error GoTo 查找記錄出錯
With dlookuplink_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
dlookuplink_rs.CursorLocation = adUseClient
Dim dlookuplink_sql As String
If rscondition <> "" Then
dlookuplink_sql = "Select * From " & rstable & " where " & rscondition
Else
dlookuplink_sql = "Select * From " & rstable
End If
dlookuplink_rs.Open dlookuplink_sql, dlookuplink_conn, adOpenDynamic, adLockOptimistic
If dlookuplink_rs.EOF = False Then
dlookuplink = dlookuplink_rs.Fields(rsfieldname)
Else
dlookuplink = nullvalue
End If
dlookuplink_rs.Close
Set dlookuplink_rs = Nothing
dlookuplink_conn.Close
Set dlookuplink_conn = Nothing
Exit Function
查找記錄出錯:
dlookuplink_rs.Close
Set dlookuplink_rs = Nothing
dlookuplink_conn.Close
Set dlookuplink_conn = Nothing
dlookuplink = nullvalue
MsgBox Err.Description
End Function
Public Function dcountlink(ByVal rsfieldname As String, ByVal rstable As String, ByVal rscondition As String, ByVal nullvalue As Long) As Long? ? ?'查詢記錄數(shù)量
Dim dcountlink_conn As New ADODB.Connection
Dim dcountlink_rs As New ADODB.Recordset
dcountlink = nullvalue
On Error GoTo 查找記錄出錯
With dcountlink_conn
? ? .ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
? ? .Open
End With
dcountlink_rs.CursorLocation = adUseClient
Dim dcountlink_sql As String
If rscondition <> "" Then
dcountlink_sql = "Select * From " & rstable & " where " & rscondition
Else
dcountlink_sql = "Select * From " & rstable
End If
dcountlink_rs.Open dcountlink_sql, dcountlink_conn, adOpenDynamic, adLockOptimistic
If dcountlink_rs.EOF = False Then
dcountlink = dcountlink_rs.RecordCount
Else
dcountlink = nullvalue
End If
dcountlink_rs.Close
Set dcountlink_rs = Nothing
dcountlink_conn.Close
Set dcountlink_conn = Nothing
Exit Function
查找記錄出錯:
dcountlink_rs.Close
Set dcountlink_rs = Nothing
dcountlink_conn.Close
Set dcountlink_conn = Nothing
dcountlink = nullvalue
MsgBox Err.Description
End Function
Public Function FileFolderExists(strFullPath As String) As Boolean? '判斷文件夾是否存在
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function
