[技巧] ADP中替代域聚合函数的一个函数

hunrybecky · 发表于 2008-3-25 10:33:33

ADP中虽然还是可以使用域聚合函数，但是引用方式等和MDB有一些区别，而且如果是远程方式速度也是一个问题，参考道士的系统，我把域聚合函数统一整理为一个函数。
Public Function hy_DFunction(ByVal strDFunctionType As String, ByVal strFieldName As String, ByVal strTableName As String, Optional ByVal strWhere As String) As Variant
'===============================================================================
'功能描述:等同于MDB中聚合函数,解决DLOOKUP函数在ADP中的问题，同时也解决了网络版DLOOKUP慢的问题,这个函数也可以用于MDB中
'参数说明:strDFunctionType原聚合函数类型;需要在表中搜索的字段名;strTableName表名;strWhere条件
'使用示例:me.lbl1.caption=hy_DFunction("Dlookup", DefaultLanguage, "sysLanguageItem", "ObjectName='frmLogin' and Control='lblRoll'")
'函数参考:道士的权限管理系统，原作者zlong
'使用注意:这个函数虽然包含了绝大多少的聚合函数的替代方式,但是对于DAvg等包含了重复值的情况,如果要排除重复值,请在SELECT后加入DISTINCT关键字
'创建日期:2008-03-25  更新日期: 2008-03-25
'调试状态:OK
'===============================================================================
Dim mySql As String
Select Case strDFunctionType
Case "DLookup"
      mySql = "SELECT " & strFieldName & " FROM " & strTableName
Case "DMax"
      mySql = "SELECT Max(" & strFieldName & ") FROM " & strTableName
Case "DMin"
      mySql = "SELECT Min(" & strFieldName & ") FROM " & strTableName
Case "DCount"
      mySql = "SELECT Count(" & strFieldName & ") FROM " & strTableName
Case "DAvg"
      mySql = "SELECT Avg(" & strFieldName & ") FROM " & strTableName
Case "DVar"
      mySql = "SELECT Var(" & strFieldName & ") FROM " & strTableName
Case "DVarP"
      mySql = "SELECT VarP(" & strFieldName & ") FROM " & strTableName
Case "DStDev"
      mySql = "SELECT StDev(" & strFieldName & ") FROM " & strTableName
Case "DStDevP"
      mySql = "SELECT StDevP(" & strFieldName & ") FROM " & strTableName
Case Else
      MsgBox hy_LanguageMsgItem("1212"), vbInformation, hy_LanguageMsgItem("1203")
      Exit Function
End Select
If Len(strWhere) > 0 Then mySql = mySql & " WHERE " & strWhere
On Error Resume Next
hy_DFunction = CurrentProject.Connection.Execute(mySql)(0)
If Err <> 0 Then '如果有错误发生则返回错误消息并返回空值
MsgBox Err.Description, vbInformation, hy_LanguageMsgItem("1203")
Err.Clear
hy_DFunction = Null
End If
End Function