关于生日提醒
假定有个员工表,有姓名和出生日期列,希望能够筛选出今天生日的行,代码为:
Dim
nms As String如果希望筛选出未来七天内生日的员工,代码为:
Dim
nms As
String
Dim n
As Integer
= 6
'未来天数,含今天,所以实际是未来7天
For
Each dr
As DataRow
In DataTables("员工").DataRows
Dim
dt As
Date = dr("出生日期")
Dim dt1
As New
Date(Date.Today.Year,dt.Month,dt.Day)
Dim dt2
As New
Date(Date.Today.AddDays(n).Year,dt.Month,dt.Day)
If
(dt1 >=
Date.Today
AndAlso
dt1 <
Date.Today.AddDays(n))
OrElse
(dt2 >=
Date.Today
AndAlso
dt2 <
Date.Today.AddDays(n))
Then
nms = nms &
",'"
& dr("姓名")
&
"'"
End
If
Next
If
nms > ""
Then
nms =
nms.Trim(",")
Tables("员工").filter
= "[姓名] In ("
& nms &")"
End If
同名问题
上面的代码有漏洞,假定有两个张三,其中一个张三今天生日,那么执行上述代码之后,两个张三都会显示出来,尽管另一个张三并不是今天生日。
要解决这个问题,可以参考下面的代码,同样以筛选出今天生日的员工为例:
Dim
ids
As String
Dim n
As Integer
= 6
'未来天数,含今天,所以实际是未来7天
For Each dr
As DataRow
In DataTables("员工").DataRows
Dim
dt
As
Date
=
dr("出生日期")
Dim
dt1
As
New
Date(Date.Today.Year,dt.Month,dt.Day)
Dim
dt2
As
New
Date(Date.Today.AddDays(n).Year,dt.Month,dt.Day)
If (dt1
>=
Date.Today
AndAlso
dt1
<
Date.Today.AddDays(n))
OrElse (dt2
>=
Date.Today
AndAlso
dt2
<
Date.Today.AddDays(n))
Then
ids
=
ids
&
","
&
dr("_Identify")
End If
Next
If
ids
>
""
Then
ids
=
ids.Trim(",")
Tables("员工").filter
=
"[_Identify] In ("
&
ids
&")"
End If
由于每一行的_Identify列的内容都是不同的,同名带来的问题不复存在。
在表达式中,因为姓名列是字符型,所以值要用单引号括起来,例如:[姓名] In ('张三', '李四', '王五');而_Identify是整数型,值不需要用单引号括起来,例如:[_Identify] In (1, 3, 7)
如果希望打开项目后,能自动筛选出当天生日的员工,可以将上面的代码设置在AfterOpenProject事件中。