Office中国论坛/Access中国论坛

标题: [技巧] ADP中替代域聚合函数的一个函数 [打印本页]

作者: hunrybecky    时间: 2008-3-25 10:33
标题: [技巧] ADP中替代域聚合函数的一个函数
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
作者: andymark    时间: 2008-3-25 10:37
先收藏再说 [:12]
作者: tmtony    时间: 2008-3-25 11:45
谢谢小不点的分享
作者: rym_yy    时间: 2008-5-22 08:46
多谢
作者: duomu    时间: 2008-7-14 12:06
呵呵,不错,分享




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3