【每日任务管理系统】(2) VB 管理系统 代码分享 Visual Basic 编程 程序 Access数据
窗体
全部任务
Dim dh As Long '存储高度差
Dim dw As Long '存储宽度差
Private Sub Command查询1_Click() '单条件查询
On Error GoTo 结束查询
Dim search_field As String
If 查询字段 = "任务日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#"
Else
rw_filter = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
End If
If 查询字段 = "倒计时天数" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大
Else
rw_filter = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " like '%" & 查询内容 & "%'"
Else
rw_filter = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command管理_Click()
On Error GoTo A1
rw_num = DataGrid1.Columns(0).Text
frm任务管理.Show 1
A1:
End Sub
Private Sub Command降序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " DESC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
rw_filter = ""
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command升序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " ASC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command生成报表_Click()
DataReport任务明细报表.DataMember = ""
With DataEnvironment1
.Commands(1).CommandType = adCmdText
.Commands(1).CommandText = "SHAPE {" & 生成查询语句("任务信息查询", rw_filter, rw_order) & "} AS Command任务查询 APPEND ({SELECT * FROM 明细查询} AS Command明细查询 RELATE '任务ID' TO '任务ID') AS Command明细查询"
.Commands(1).Execute ("SHAPE {" & 生成查询语句("任务信息查询", rw_filter, rw_order) & "} AS Command任务查询 APPEND ({SELECT * FROM 明细查询} AS Command明细查询 RELATE '任务ID' TO '任务ID') AS Command明细查询")
If .rsCommand任务查询.State = 1 Then
.rsCommand任务查询.Close
End If
Set DataReport任务明细报表.DataSource = DataEnvironment1
DataReport任务明细报表.DataMember = "Command任务查询"
End With
'打开报表
DataReport任务明细报表.Show 1
End Sub
Private Sub Command添加_Click()
If 任务添加权限 = False Then
MsgBox "无权限"
Exit Sub
End If
frm任务添加.Show 1
End Sub
Private Sub Form_Load()
'筛选排序变量清空
rw_filter = ""
rw_order = "任务ID DESC"
查询内容.Visible = True
'--隐藏日期控件
起始日期.Visible = False
截止日期.Visible = False
'--隐藏金额控件
最小.Visible = False
最大.Visible = False
'标签
Label查询内容.Visible = True
'--隐藏日期控件
Label起始日期.Visible = False
Label截止日期.Visible = False
'--隐藏金额控件
Label最小.Visible = False
Label最大.Visible = False
'ado控件设置
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 = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh '刷新
'存储数据表格控件与窗体宽高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Function 生成查询语句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String
生成查询语句 = ""
Dim sqltext As String
sqltext = "Select * From " & searchtb
If searchfilter <> "" Then
sqltext = sqltext & " where " & searchfilter
End If
If searchorder <> "" Then
sqltext = sqltext & " order by " & searchorder
End If
生成查询语句 = sqltext
End Function
Private Sub Form_Resize()
'窗体大小变化表格控件尺寸改变
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub 查询字段_Click()
If 查询字段 = "任务日期" Then
起始日期.Visible = True
截止日期.Visible = True
最小.Visible = False
最大.Visible = False
查询内容.Visible = False
起始日期.Value = Date
截止日期.Value = Date
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查询内容.Visible = True
End If
If 查询字段 = "倒计时天数" Then
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = True
最大.Visible = True
查询内容.Visible = False
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查询内容.Visible = True
End If
A1:
'标签
If 查询字段 = "任务日期" Then
Label起始日期.Visible = True
Label截止日期.Visible = True
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = True
End If
If 查询字段 = "倒计时天数" Then
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = True
Label最大.Visible = True
Label查询内容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = True
End If
a2:
End Sub
任务查询
Dim dh As Long '存储高度差
Dim dw As Long '存储宽度差
Private Sub Command查询1_Click() '单条件查询
On Error GoTo 结束查询
Dim search_field As String
If 查询字段 = "任务日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#" & " and 创建账号 ='" & login_name & "'"
Else
rw_filter = "创建账号 ='" & login_name & "'"
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
End If
If 查询字段 = "倒计时天数" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大 & " and 创建账号 ='" & login_name & "'"
Else
rw_filter = "创建账号 ='" & login_name & "'"
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = 查询字段
rw_filter = search_field & " like '%" & 查询内容 & "%'" & " and 创建账号 ='" & login_name & "'"
Else
rw_filter = "创建账号 ='" & login_name & "'"
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command管理_Click()
On Error GoTo A1
rw_num = DataGrid1.Columns(0).Text
frm任务管理.Show 1
A1:
End Sub
Private Sub Command降序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " DESC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
rw_filter = "创建账号 ='" & login_name & "'"
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command升序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " ASC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command生成报表_Click()
DataReport任务明细报表.DataMember = ""
With DataEnvironment1
.Commands(1).CommandType = adCmdText
.Commands(1).CommandText = "SHAPE {" & 生成查询语句("任务信息查询", rw_filter, rw_order) & "} AS Command任务查询 APPEND ({SELECT * FROM 明细查询} AS Command明细查询 RELATE '任务ID' TO '任务ID') AS Command明细查询"
.Commands(1).Execute ("SHAPE {" & 生成查询语句("任务信息查询", rw_filter, rw_order) & "} AS Command任务查询 APPEND ({SELECT * FROM 明细查询} AS Command明细查询 RELATE '任务ID' TO '任务ID') AS Command明细查询")
If .rsCommand任务查询.State = 1 Then
.rsCommand任务查询.Close
End If
Set DataReport任务明细报表.DataSource = DataEnvironment1
DataReport任务明细报表.DataMember = "Command任务查询"
End With
'打开报表
DataReport任务明细报表.Show 1
End Sub
Private Sub Command添加_Click()
If 任务添加权限 = False Then
MsgBox "无权限"
Exit Sub
End If
frm任务添加.Show 1
End Sub
Private Sub Form_Load()
'筛选排序变量清空
rw_filter = "创建账号 ='" & login_name & "'"
rw_order = "任务ID DESC"
查询内容.Visible = True
'--隐藏日期控件
起始日期.Visible = False
截止日期.Visible = False
'--隐藏金额控件
最小.Visible = False
最大.Visible = False
'标签
Label查询内容.Visible = True
'--隐藏日期控件
Label起始日期.Visible = False
Label截止日期.Visible = False
'--隐藏金额控件
Label最小.Visible = False
Label最大.Visible = False
'ado控件设置
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 = 生成查询语句("任务信息查询", rw_filter, rw_order)
Adodc1.Refresh '刷新
'存储数据表格控件与窗体宽高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Function 生成查询语句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String
生成查询语句 = ""
Dim sqltext As String
sqltext = "Select * From " & searchtb
If searchfilter <> "" Then
sqltext = sqltext & " where " & searchfilter
End If
If searchorder <> "" Then
sqltext = sqltext & " order by " & searchorder
End If
生成查询语句 = sqltext
End Function
Private Sub Form_Resize()
'窗体大小变化表格控件尺寸改变
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub 查询字段_Click()
If 查询字段 = "任务日期" Then
起始日期.Visible = True
截止日期.Visible = True
最小.Visible = False
最大.Visible = False
查询内容.Visible = False
起始日期.Value = Date
截止日期.Value = Date
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查询内容.Visible = True
End If
If 查询字段 = "倒计时天数" Then
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = True
最大.Visible = True
查询内容.Visible = False
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查询内容.Visible = True
End If
A1:
'标签
If 查询字段 = "任务日期" Then
Label起始日期.Visible = True
Label截止日期.Visible = True
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = True
End If
If 查询字段 = "倒计时天数" Then
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = True
Label最大.Visible = True
Label查询内容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查询内容.Visible = True
End If
a2:
End Sub
任务添加
Dim dh As Long '存储高度差
Dim dw As Long '存储宽度差
Private Sub Text_DblClick(Index As Integer)
If Index = 0 Then
rw_formname = "frm任务添加"
frm常见任务选择.Show 1
End If
If Index = 1 Then '双击输入日期的文本框
If Text(1) <> "" Then
DTPicker1.Value = Text(1)
Else
Text(1) = Date
DTPicker1.Value = Date
End If
DTPicker1.Visible = True '显示日期选择控件
End If
End Sub
Private Sub Command清空_Click()
Text(0) = ""
Text(1) = ""
Text(2) = ""
Text(3) = ""
Combo1(0) = ""
Combo1(1) = ""
Combo1(2) = ""
Combo1(3) = ""
DTPicker1.Visible = False '日期控件隐藏
End Sub
Private Sub Command添加_Click()
On Error GoTo 错误提示
If 任务添加权限 = False Then
MsgBox "无权限"
Exit Sub
End If
'判断必须输入数据的控件不能为空
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "任务名称值为空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任务日期值为空！"
Exit Sub
Else
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 = Text(0)
add_rs!任务日期.Value = Text(1)
add_rs!任务描述.Value = Text(2)
add_rs!备注.Value = Text(3)
add_rs!创建账号.Value = login_name
add_rs!任务负责人.Value = Combo1(0)
add_rs!任务时间.Value = Combo1(1)
add_rs!任务类型.Value = Combo1(2)
add_rs!任务状态.Value = Combo1(3)
add_rs.Update
add_rs.Close
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox "添加完成"
Call Command清空_Click
Adodc1.Refresh
DataGrid1.Refresh
Exit Sub
错误提示:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
'ado控件设置
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 任务表 where 创建账号 ='" & login_name & "' Order By 任务ID DESC"
Me.Adodc1.Refresh '刷新
'
'存储数据表格控件与窗体宽高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
Call 设置任务类型选项
Call 设置任务状态选项
Call 设置负责人选项
End Sub
Private Sub Form_Resize()
'窗体大小变化表格控件尺寸改变
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm任务查询.Adodc1.Refresh
frm任务查询.DataGrid1.Refresh
frm全部任务.Adodc1.Refresh
frm全部任务.DataGrid1.Refresh
frm系统主页.Adodc1.Refresh
frm系统主页.DataGrid1.Refresh
End Sub
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom '日期格式设置
Text(1).Text = DTPicker1.Value '返回选择的日期值至文本框
DTPicker1.Visible = False '日期控件隐藏
End Sub
Private Sub Text_LostFocus(Index As Integer)
If Index = 1 Then '输入日期的文本框失去焦点
If Text(1).Text <> "" And IsDate(Text(1)) = False Then
MsgBox "输入的数据不是日期类型，请重新输入"
Text(1).Text = ""
DTPicker1.Value = False
Exit Sub
End If
End If
End Sub
Sub 设置任务类型选项()
Dim i As Long
'-清除选项
Combo1(2).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任务类型表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任务类型 <> "" Then
Combo1(2).AddItem search_rs!任务类型
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
Sub 设置任务状态选项()
Dim i As Long
'-清除选项
Combo1(3).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任务状态表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任务状态 <> "" Then
Combo1(3).AddItem search_rs!任务状态
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
Sub 设置负责人选项()
Dim i As Long
'-清除选项
Combo1(0).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 负责人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!负责人 <> "" Then
Combo1(0).AddItem search_rs!负责人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
任务管理
Private Sub Command更新_Click()
On Error GoTo 更新失败错误
If 任务更新权限 = False Then
MsgBox "无权限"
Exit Sub
End If
If MsgBox("是否更新该任务记录?", vbOKCancel) <> vbOK Then
Exit Sub
End If
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "任务名称值为空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任务日期值为空！"
Exit Sub
Else
End If
'连接数据库并更新
Adodc1.Recordset.Update
MsgBox "更新完成！"
Exit Sub
更新失败错误:
MsgBox Err.Description
End Sub
Private Sub Command明细删除_Click()
On Error GoTo D1
If MsgBox("是否删除该明细记录？明细ID：" & DataGrid1.Columns(0), vbYesNo) <> vbYes Then
Exit Sub
End If
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
update_rs.Open "select * From 明细表 where 明细ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
On Error Resume Next
update_rs.Delete
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
Me.Adodc2.Refresh '刷新
D1:
End Sub
Private Sub Command明细添加_Click()
frm明细添加.Show 1
End Sub
Private Sub Command删除_Click()
On Error GoTo 删除失败错误
If 任务删除权限 = False Then
MsgBox "无权限"
Exit Sub
End If
If MsgBox("是否删除该任务记录?", vbOKCancel) <> vbOK Then
Exit Sub
End If
Adodc1.Recordset.Delete
MsgBox "删除完成"
Unload Me
Exit Sub
删除失败错误:
MsgBox Err.Description
End Sub
Private Sub Command未完成_Click()
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
update_rs.Open "select * From 明细表 where 明细ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
On Error Resume Next
update_rs!是否完成.Value = False
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
Me.Adodc2.Refresh '刷新
'Me.DataGrid1.Refresh
End Sub
Private Sub Command已完成_Click()
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
update_rs.Open "select * From 明细表 where 明细ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
On Error Resume Next
update_rs!是否完成.Value = True
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
Me.Adodc2.Refresh '刷新
End Sub
Private Sub Form_Load()
Call 设置任务类型选项
Call 设置任务状态选项
Call 设置负责人选项
'ado控件设置
Me.Adodc1.Refresh '刷新
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 任务表 where 任务ID=" & rw_num
Me.Adodc1.Refresh '刷新
'
Me.Adodc2.Refresh '刷新
Me.Adodc2.CommandType = adCmdUnknown
Me.Adodc2.RecordSource = "select * From 明细查询 where 任务ID=" & rw_num
Me.Adodc2.Refresh '刷新
Me.DataGrid1.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm任务查询.Adodc1.Refresh
frm任务查询.DataGrid1.Refresh
frm全部任务.Adodc1.Refresh
frm全部任务.DataGrid1.Refresh
End Sub
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom '日期格式设置
Text(1).Text = DTPicker1.Value '返回选择的日期值至文本框
DTPicker1.Visible = False '日期控件隐藏
End Sub
Private Sub Text_DblClick(Index As Integer)
If Index = 1 Then '双击输入日期的文本框
If Text(1) <> "" Then
DTPicker1.Value = Text(1)
Else
Text(1) = Date
DTPicker1.Value = Date
End If
DTPicker1.Visible = True '显示日期选择控件
End If
End Sub
Private Sub Text_LostFocus(Index As Integer)
If Index = 1 Then '输入日期的文本框失去焦点
If Text(1).Text <> "" And IsDate(Text(1)) = False Then
MsgBox "输入的数据不是日期类型，请重新输入"
Text(1).Text = ""
DTPicker1.Value = False
Exit Sub
End If
End If
End Sub
Sub 设置任务类型选项()
Dim i As Long
'-清除选项
Combo1(2).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任务类型表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任务类型 <> "" Then
Combo1(2).AddItem search_rs!任务类型
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
Sub 设置任务状态选项()
Dim i As Long
'-清除选项
Combo1(3).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任务状态表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任务状态 <> "" Then
Combo1(3).AddItem search_rs!任务状态
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
Sub 设置负责人选项()
Dim i As Long
'-清除选项
Combo1(0).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 负责人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!负责人 <> "" Then
Combo1(0).AddItem search_rs!负责人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
明细添加
Private Sub Command清空_Click()
Text(0) = ""
Text(2) = ""
Combo1(0) = ""
Option2.Value = True
End Sub
Private Sub Command添加_Click()
On Error GoTo 错误提示
If Text(2) = "" Or IsNull(Text(2)) = True Then
MsgBox "明细内容值为空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任务ID值为空！"
Exit Sub
Else
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!任务ID.Value = Text(1)
add_rs!明细时间.Value = Text(0)
add_rs!明细内容.Value = Text(2)
add_rs!明细负责人.Value = Combo1(0)
add_rs!是否完成.Value = CBool(Option1.Value)
add_rs.Update
add_rs.Close
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox "添加完成"
Call Command清空_Click
frm任务管理.Adodc2.Refresh
frm任务管理.DataGrid1.Refresh
Exit Sub
错误提示:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Text(1).Text = rw_num
Call 设置负责人选项
End Sub
Sub 设置负责人选项()
Dim i As Long
'-清除选项
Combo1(0).Clear
'-查询并填充选项
On Error GoTo 查询失败错误
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 负责人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!负责人 <> "" Then
Combo1(0).AddItem search_rs!负责人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查询失败错误:
MsgBox Err.Description
End Sub
数据库
每日任务计划管理系统后端采用access数据库存储数据，格式为mdb，命名为db_rw，为了保证安全性，数据库设置加密，密码为abc123。
表
常见任务表
负责人表
明细表
任务表
任务类型表
任务状态表
表关系
查询
今日任务查询
SELECT 任务表.任务ID, 任务表.任务名称, 任务表.任务日期, 任务表.任务时间, 任务表.任务描述, 任务表.任务负责人, 任务表.任务类型, 任务表.任务状态, IIf([任务日期]-Date()>=0,[任务日期]-Date(),"已超期") AS 倒计时天数, 任务表.备注, 任务表.创建账号
FROM 任务表
WHERE (((任务表.任务日期)=Date()));
明细查询
SELECT 明细表.明细ID, 明细表.任务ID, 明细表.明细时间, 明细表.明细内容, 明细表.明细负责人, IIf([是否完成]=0,"否","是") AS 已完成, 明细表.是否完成
FROM 明细表;
任务信息查询
SELECT 任务表.任务ID, 任务表.任务名称, 任务表.任务日期, 任务表.任务时间, 任务表.任务描述, 任务表.任务负责人, 任务表.任务类型, 任务表.任务状态, IIf([任务日期]-Date()>=0,[任务日期]-Date(),"已超期") AS 倒计时天数, 任务表.备注, 任务表.创建账号
FROM 任务表;
